DECLARE SUB options ()
DECLARE SUB font (msg$, LXP!, LYP!, FC, BC, s!, st!, VT!, WID!, Shado!)
DECLARE SUB dadstune ()
DECLARE SUB init ()
SCREEN 13: CLS
TYPE acred
  y AS SINGLE
  clr AS SINGLE
  txt AS STRING * 31
END TYPE

DIM SHARED Pack(1 TO 3) AS INTEGER
DIM SHARED Credits(10) AS acred
DIM SHARED text(10, 150)
DIM SHARED bulldozer(600)
DIM SHARED topwin(12, 9)
DIM y AS SINGLE
TYPE DOTS
x AS SINGLE
y AS SINGLE
spd AS SINGLE
clr AS INTEGER
END TYPE
DIM dot(1 TO 1000) AS DOTS
DIM num AS LONG
DATA 0,0,0,0,1,1,1,1,0,0,0,0
DATA 0,1,1,1,2,2,2,2,1,1,1,0
DATA 1,3,3,3,3,-1,3,3,3,3,3,1
DATA 1,4,4,4,-1,4,4,4,-1,4,4,1
DATA 1,5,5,-1,5,5,5,-1,5,5,5,1
DATA 1,6,6,6,6,6,6,6,6,6,6,1
DATA 0,1,1,1,7,7,7,7,1,1,1,0
DATA 0,0,0,0,1,1,1,1,0,0,0,0

  FOR y = 1 TO 8
    FOR i = 0 TO 11
      READ topwin(i, y)
    NEXT i
  NEXT y

restart:
init
FOR i = 1 TO Pack(1)
  RANDOMIZE TIMER
  dot(i).x = RND * 320
  RANDOMIZE TIMER
  dot(i).y = 0
  RANDOMIZE TIMER
  dot(i).spd = (RND * .5) + .5
  dot(i).clr = dot(i).spd * 6 + 24
NEXT i
COLOR 41
LOCATE 10, 20

LINE (0, 200)-(320, 200), 28

DO
LOCATE 21, 5
COLOR 22
PRINT num
FOR i = 1 TO Pack(1)
 IF POINT(dot(i).x, dot(i).y + 1) <> 0 THEN
   IF POINT(dot(i).x + 1, dot(i).y) = 0 THEN IF POINT(dot(i).x + 1, dot(i).y + 1) = 0 THEN PSET (dot(i).x, dot(i).y), 0: dot(i).x = dot(i).x + 1: GOTO moved
   IF POINT(dot(i).x - 1, dot(i).y) = 0 THEN IF POINT(dot(i).x - 1, dot(i).y + 1) = 0 THEN PSET (dot(i).x, dot(i).y), 0: dot(i).x = dot(i).x - 1: GOTO moved
  
   dot(i).y = 0
   RANDOMIZE TIMER
   dot(i).x = RND * 320
   dot(i).spd = (RND * .5) + .5
   dot(i).clr = (dot(i).spd - .5) * 12 + 24
   num = num + 1
   IF num > Pack(2) THEN num = 0:  special = special + 1: GOSUB buldoze: CLS : GOTO restart

moved:
 END IF
 PSET (dot(i).x, dot(i).y), 0
 dot(i).y = dot(i).y + dot(i).spd
 PSET (dot(i).x, dot(i).y), dot(i).clr
NEXT i
LOOP UNTIL INKEY$ = "e" OR INKEY$ = "E"

PRINT (special * Pack(2)) + num
END
buldoze:
x = 0
y = 0
num = 0
DO
  LINE (x - 1, y)-(x - 1, y + 34), 0
  PUT (x, y), bulldozer, PSET
  FOR del = 1 TO Pack(3): NEXT del
  x = x + 1
  IF x = 269 THEN LINE (x - 1, y)-(320, y + 34), 0, BF: y = y + 20.6: x = 0
LOOP WHILE y < 170
RETURN

SUB font (msg$, LXP, LYP, FC, BC, s, st, VT, WID, Shado)
DRAW "a0"
IF LXP = -1 THEN LXP = OLXP
IF LYP = -1 THEN LYP = OLYP
IF LXP = -2 THEN
m$ = ""
FOR sv = 1 TO LEN(msg$)
IF MID$(msg$, sv, 1) <> " " THEN m$ = m$ + MID$(msg$, sv, 1)
IF MID$(msg$, sv, 1) = "^" THEN sv = sv + 1
NEXT sv
LXP = INT((WID / 2) - (LEN(m$) * 10) / 2)
END IF
IF LYP = -2 THEN LYP = CINT(((39 - 5) / 2) * 5)
U = -1: OLXP = LXP: OLYP = LYP
A$ = STR$(LXP): B$ = STR$(LYP): BC$ = STR$(BC): FC$ = STR$(FC): s$ = STR$(s)
msg$ = UCASE$(msg$)
FOR sv = 1 TO LEN(m$) + 8
SELECT CASE MID$(msg$, sv, 1)
CASE "A"
M1$ = "u2e2f2l4r4d2"
CASE "B"
M1$ = "u4r3fgl2r2fgl3"
CASE "C"
M1$ = "brr3l3hu2er3"
CASE "D"
M1$ = "u4r3fd2gl3"
CASE "E"
M1$ = "u4r4l4d2r2l2d2r4"
CASE "F"
M1$ = "u4r4l4d2r2"
CASE "G"
M1$ = "brr3l3hu2er3l3gd2fr3u2l2"
CASE "H"
M1$ = "u4d2r4u2d4"
CASE "I"
M1$ = "r4l2u4l2r4"
CASE "J"
M1$ = "brhfr2eu3"
CASE "K"
M1$ = "u4d3e3g2f2"
CASE "L"
M1$ = "u4d4r4"
CASE "M"
M1$ = "u4f2e2d4"
CASE "N"
M1$ = "u4f4u4"
CASE "O"
M1$ = "brhu2er2fd2gl2"
CASE "P"
M1$ = "u4r3fgl3"
CASE "Q"
M1$ = "brhu2er2fd2dhfl3"
CASE "R"
M1$ = "u4r3fgl3r2f2"
CASE "S"
M1$ = "r3ehl2her3"
CASE "T"
M1$ = "br2u4l2r4"
CASE "U"
M1$ = "brhu3d3fr2eu3"
CASE "V"
M1$ = "br2h2u2d2f2e2u2"
CASE "W"
M1$ = "buu3d3fefeu3"
CASE "X"
M1$ = "e4g2f2h4"
CASE "Y"
M1$ = "br2u2e2g2h2f2"
CASE "Z"
M1$ = "r4l4e4l4"
CASE ":"
M1$ = "br2rulbu2rul"
CASE "."
M1$ = "br2r"
CASE "!"
M1$ = "br2rbu2u2ld2"
CASE "?"
M1$ = "br2rbu2lrehl2g"
CASE ","
M1$ = "relur"
CASE "'"
M1$ = "brbu2relur"
CASE "/"
M1$ = "e4"
CASE "("
M1$ = "br3hu2e"
CASE ")"
M1$ = "breu2h"
CASE "1"
M1$ = "brr2lu4l"
CASE "2"
M1$ = "r4l4uer2ehl3"
CASE "3"
M1$ = "bufr2eheul4"
CASE "4"
M1$ = "br3u4g3r4"
CASE "5"
M1$ = "r3ehl3u2r4"
CASE "6"
M1$ = "bufr2ehl3uer3"
CASE "7"
M1$ = "br2ue2ul4"
CASE "8"
M1$ = "bufr2ehl2her2f"
CASE "9"
M1$ = "brr2eu2hl2gfr2"
CASE "0"
M1$ = "bufr2eu2hl2gd2bre2"
CASE "^"
IF MID$(msg$, sv + 1, 1) = "N" THEN LYP = LYP + 5 + VT: LXP = OLXP: B$ = STR$(LYP): A$ = STR$(LXP)
IF MID$(msg$, sv + 1, 1) = "U" THEN U = -U
M1$ = "": sv = sv + 1: LXP = LXP - 5 - st
CASE ELSE
END SELECT
IF U = 1 THEN DRAW "s" + s$ + "bm" + A$ + "," + B$ + "c" + BC$ + "bd5brr" + STR$(4 + st): DRAW "bm" + A$ + "," + B$ + "c" + FC$ + "bd6r" + STR$(4 + st)
IF Shado = 0 THEN
  DRAW "bm" + A$ + "," + B$ + "s" + s$ + "c" + BC$ + "bd4br" + M1$ + "bm" + A$ + "," + B$: DRAW "c" + FC$ + "bd5" + M1$
ELSE
  DRAW "bm" + A$ + "," + B$ + "s" + s$ + "c" + FC$ + "bd5br" + M1$
END IF
LXP = LXP + 5 + st
IF LXP + 5 + st > WID - (s + 1) THEN LYP = LYP + 5 + VT: LXP = OLXP
A$ = STR$(LXP): B$ = STR$(LYP)
M1$ = ""
NEXT sv
'LYP = LYP + 5 + VT: LXP = OLXP
'OLXP = LXP: OLYP = LYP
END SUB

SUB init
Credits(1).txt = "Falling SNOW"
Credits(2).txt = "A program written by"
Credits(3).txt = "Danny Beardsley"
Credits(4).txt = "in Qbasic"
Credits(5).txt = "press 'e' to exit"
Credits(6).txt = "press 'o' to change options"
Credits(7).txt = "press any other key to continue"
Credits(1).y = 10
Credits(2).y = 20
Credits(3).y = 50
Credits(4).y = 70
Credits(5).y = 90
Credits(6).y = 100
Credits(7).y = 120
Pack(1) = 160
Pack(2) = 15000
Pack(3) = 1500
SCREEN 13
DO
  FOR i = 1 TO 7
    Credits(i).clr = INT(30 - ABS(Credits(i).y - 100) / 7)
    LINE (10, Credits(i).y)-(300, Credits(i).y + 5), 0, BF
    font (Credits(i).txt), -2, Credits(i).y, Credits(i).clr, 10, 4, 3, 4, 320, -1
    IF Credits(i).y > 198 THEN Credits(i).y = 1
    Credits(i).y = Credits(i).y + 1
    
  NEXT i
keyS$ = INKEY$
LOOP WHILE keyS$ = ""
IF keyS$ = "e" OR keyS$ = "E" THEN
  END
ELSEIF keyS$ = "o" OR keyS$ = "O" THEN
  options
ELSE
END IF
'bull dozer
PSET (2, 9), 0
  'top and smoke stack
   DRAW "bd4 br4 c43 r15 u1 c20 u13 c22 r1 d14 c43 r9"
 
  'front and middle
  
   'window
    DRAW "c42 f10 bl1 bh9 c43 f9 l1 c25 l13 u1"
    DRAW "c96 r12 h1 C97 l11 u1 c98 r10 h1"
    DRAW "c99 l9 u1 c100 r8 h1 C101 l7 u1"
    DRAW "c102 r6 h1 C103 l5 u1 c103 r4 bl5 c23 d3 c24 d3 c25 d3"
  
   'side DSB
    DRAW "l1 c44 u9 l18 d9 r18 bh4 p43,44 bd2 bl12"
    DRAW "c21 u5 c22 r2 bf1 c23 d3 c22 bg1 l2 br5 bu1 c24"
    DRAW "f1 r1 be1 c25 u1 h1 c24 l1 h1 e1 r1 br3 c26 d5"
    DRAW "c27 r2 c27 e1 u1 bh1 c26 l2 r2 e1 h1 l2 bd5 bl13"
 
  'BOTTOM
  
   'pipe1
    DRAW "c23 g3 d4 f3 u1 c25 h2 u4 e2 d1 c23 g1 d4 f1 "
  
   'pipe2
    DRAW "c42 bu3 l3 h2 u4 e2 r3 d1 c43 l3 g1 d4 f1 r3"
  
   'fender thing
    DRAW "bu1 br1 c23 r35 d1 c24 l35 d1 c25 r4 br28 r3"
    DRAW "c26 bl35 d1 r2 l2 d1 c27 r1 l1 d1 c28 d1"
  
   'wheels
    DRAW "br6 "
   
    'main wheels
     CIRCLE STEP(0, 0), 4, 23: CIRCLE STEP(0, 0), 3, 25: CIRCLE STEP(0, 0), 2, 27: CIRCLE STEP(24, 0), 4, 23: CIRCLE STEP(0, 0), 3, 25: CIRCLE STEP(0, 0), 2, 27
   
    'lil wheels
    
     'lil wheel 1
      DRAW "bl7 bu3 l1 g1 d1 f1 r1 e1 u1 l1 c24 d1 l1 u1 bu1 bl8"
    
     'lil wheel 2
      DRAW "c27 l1 g1 d1 f1 r1 e1 u1 l1 c24 d1 l1 u1 br5 bd2"
    
     'lil wheel 3
      DRAW "c27 l1 g1 d1 f1 r1 e1 u1 l1 c24 d1 l1 u1 br18"
   
    'treads
     DRAW "c221 u2 c219 h2 c217 l1 h1 c215 l26 c217 g1 l1 c219 g2"
     DRAW "c221 d2 c219 f2 c217 r1 f1 c215 r26 c217 e1 r1 c219 e2"
 
  'dozer
  
   'arm
    DRAW "bu9 bl18 c42 d1 u1 g1 f1 e1"
    DRAW "c114 r17 e5 bd10 h5 u1"
    DRAW "c115 e5 bd2 g4 f4 bd2 h5 l17"
    DRAW "c21 g1  h2  e2  f1 c115 r17"
  
   'hydrolics ''''''''who carse abouut speeling
    DRAW "bh9 bl8 c20 u1 g1 c23 f1 e1 f5"
    DRAW "d1 c27 f3 d1 e1 l1 h8 d1 c22 f4"
  
   'the pusher
    DRAW "br21 bd15 c28 h2 u1 h1 u13 e1 u1 e2 r1"
    DRAW "c24 g2 d1 g1 d13 f1 d1 f2"
GET (0, 0)-(51, 34), bulldozer
CLS



PRINT "A taste of winter!"
FOR y = 0 TO 10
  FOR x = 0 TO 150
    IF POINT(x, y) <> 0 THEN text(y, x) = 1
  NEXT x
NEXT y
CLS
FOR y = 0 TO 10
  FOR x = 0 TO 150
    IF text(y, x) = 1 THEN
      'PSET (x + 5, y + 148), y + 18
      PSET (x + 101, y + 48), y + 32
    END IF
  NEXT x
NEXT y



'+++++++++++++++HOUSE++++++++++++++++
 'front wall
  colr = 208
  FOR y = 140 TO 198 STEP 4
    LINE (240, y)-(310, y), colr
    LINE (240, y + 1)-(310, y + 1), colr + 1
    LINE (240, y + 2)-(310, y + 2), colr + 2
    LINE (240, y + 3)-(310, y + 3), 18
  NEXT y
 
 'chimeny
  colr = 20
  FOR x = 253 TO 263
    RANDOMIZE TIMER
    LINE (x, 100)-(x, 130), x - 253 + colr
  NEXT x
 
 'roofline left
  y = 140
  y2 = 105
  x = 240
  x2 = 275
  colr = 208
  LINE (x, y)-(x2, y2), colr
  LINE (x, y + 1)-(x2, y2 + 1), colr + 1
  LINE (x, y + 2)-(x2, y2 + 2), colr + 2
 
 'roofline right
  y = 140
  y2 = 105
  x = 310
  x2 = 275
  colr = 208
  LINE (x, y)-(x2, y2), colr
  LINE (x, y + 1)-(x2, y2 + 1), colr + 1
  LINE (x, y + 2)-(x2, y2 + 2), colr + 2
 
 'roof  fill
  y = 105
  FOR x = 275 TO 244 STEP -1
  y = y + 1
  x2 = 275 - x + 275
  LINE (x, y + 2)-(x2, y + 2), colr + (y MOD 3)
  NEXT x
  
 'outer wall
  y = 140
  y2 = 198
  x = 240
  x2 = 310
  colr = 208
  LINE (x, y)-(x2, y2), colr, B
  LINE (x + 1, y + 1)-(x2 - 1, y2 - 1), colr + 1, B
  LINE (x + 2, y + 2)-(x2 - 2, y2 - 2), colr + 2, B

 'bottom window
  y = 160
  y2 = 180
  x = 245
  x2 = 265
  colr = 26
  s = 0
  LINE (x + s, y + s)-(x2 - s, y2 - s), colr + s, B
  colr = 56
  x = 246
  x2 = 264
  FOR s = 1 TO 15 STEP 3
    LINE (x, y + s)-(x2, y + s + 6), colr + c, BF
    c = c + 1
  NEXT s
  
  'reflect in window
   LINE (247, 176)-(262, 161), 30
   LINE (257, 176)-(262, 171), 28
   LINE (250, 168)-(257, 161), 29
   LINE (248, 164)-(250, 162), 30
  'cross in window
   LINE (246, 170)-(264, 170), 28
   LINE (255, 161)-(255, 179), 28
 
 'door
  colr = 20
  FOR x = 275 TO 290 STEP 3
    colr = colr + 1
    LINE (x, 165)-(x + 3, 194), colr, BF
  NEXT x
  'door handle
  CIRCLE (278, 179), 1, 24
  PSET (278, 179), 28

 'top window
  FOR y = 1 TO 8
    FOR i = 0 TO 11
      c = topwin(i, y)
      IF c <> 0 THEN PSET ((i MOD 12) + 269, y + 122), c + 23
      IF c = -1 THEN PSET ((i MOD 12) + 269, y + 122), 30
    NEXT i
  NEXT y

' trees
DIM draws AS STRING
DIM bio AS LONG
DIM bios(20) AS INTEGER
DIM tl AS SINGLE
DIM lenth AS SINGLE
CONST right = -1
CONST left = 0
begin:

rinc = 20
linc = 25
jum = 11
org = 58
number = 5


FOR A = 1 TO 2 ^ (jum)
PSET (100, 198)
DRAW "ta0"
angle = 0
bio = bio + 1
'bios(1) = NOT bios(1)
FOR i = 1 TO jum
  IF ((bio) MOD (2 ^ (i - 1))) = 0 THEN bios(i) = NOT (bios(i))
NEXT i
tl = org

FOR i = jum TO 1 STEP -1
  DRAW "c" + STR$(146 - i)
  lenth = INT(((2 ^ (-3 / (2 * number))) * tl))
  tl = lenth
  IF bios(i) = right THEN
    angle = (angle + rinc) MOD 360
    draws = draws + "u" + STR$(INT(lenth / 2)) + "ta" + STR$(angle)
  END IF
  IF bios(i) = left THEN
    'angle = (angle + rinc) MOD 360
    angle = angle - linc
    IF angle < 0 THEN angle = angle + 360
    draws = draws + "u" + STR$(INT(lenth / 2)) + "ta" + STR$(angle)
  END IF
  DRAW draws
  draws = ""
NEXT i
NEXT A

font "By Danny Beardsley", 34, 193, 41, 32, 4, 3, 4, 40 + 180, 0

END SUB

SUB options
SCREEN 12
DIM max(1 TO 3) AS LONG
CLS
max(1) = 1000
max(2) = 100000
max(3) = 3000
Pack(1) = 160
Pack(2) = 15000
Pack(3) = 1500
 
  CLS
  font "Here are some options", -2, 10, 10, 8, 10, 10, 14, 600, 0
  font "for the program", -2, 30, 10, 8, 10, 10, 14, 600, 0
  COLOR 4
  LOCATE 5, 26
  PRINT "Use the up and down arrowkeys to control"
  LOCATE 6, 26
  PRINT "      which number you are changing"
  LOCATE 7, 24
  PRINT "Use the right and left arrowkeys to change"
  LOCATE 8, 24
  PRINT "        the value of the number"

  LOCATE 10, 3
  COLOR 12
  PRINT "this the number of flakes that will be    I--->"
  LOCATE 11, 3
  PRINT "               falling "
  LOCATE 17, 3
  COLOR 13
  PRINT "this the number of flakes that will fall  I--->"
  LOCATE 18, 3
  PRINT "      before the screen is cleared"
  LOCATE 24, 3
  COLOR 7
  PRINT "   this is the speed of the bulldozer    I--->"
  LOCATE 25, 3
  PRINT " (0-3000) 0 is fastest, 3000 is slowest"
  COLOR 14
  POSS = 1
  FOR P = 1 TO 3
    LOCATE P * 7 + 3, 50
    PRINT "          "
    LOCATE P * 7 + 3, 50
    PRINT " "; Pack(P)
  NEXT P
  LOCATE POSS * 7 + 3, 50
  PRINT "          "
  LOCATE POSS * 7 + 3, 50
  PRINT "["; Pack(POSS); "]"
  DO
    keyS$ = INKEY$
    SELECT CASE keyS$
      CASE "d"
        EXIT DO
      CASE "D"
        EXIT DO
      CASE CHR$(0) + "H"
        LOCATE POSS * 7 + 3, 50
        PRINT "       "
        LOCATE POSS * 7 + 3, 50
        PRINT " "; Pack(POSS); "  "
        POSS = POSS - 1
        IF POSS < 1 THEN POSS = 3
        LOCATE POSS * 7 + 3, 50
        PRINT "        "
        LOCATE POSS * 7 + 3, 50
        PRINT "["; Pack(POSS); "]"
       
      CASE CHR$(0) + "P"
        LOCATE POSS * 7 + 3, 50
        PRINT "       "
        LOCATE POSS * 7 + 3, 50
        PRINT " "; Pack(POSS); " "
        POSS = (POSS + 1)
        IF POSS > 3 THEN POSS = 1
        LOCATE POSS * 7 + 3, 50
        PRINT "        "
        LOCATE POSS * 7 + 3, 50
        PRINT "["; Pack(POSS); "]"
    
      CASE CHR$(0) + "M"
        IF Pack(POSS) < max(POSS) THEN
          IF POSS = 1 THEN
            Pack(POSS) = Pack(POSS) + 2
          ELSEIF POSS = 2 THEN
            Pack(POSS) = Pack(POSS) + 50
          ELSE
            Pack(POSS) = Pack(POSS) + 10
          END IF
          LOCATE POSS * 7 + 3, 50
          PRINT "       "
          LOCATE POSS * 7 + 3, 50
          PRINT "["; Pack(POSS); "]"
        END IF
     
      CASE CHR$(0) + "K"
        IF Pack(POSS) > 5 THEN
          IF POSS = 1 THEN
            Pack(POSS) = Pack(POSS) - 2
          ELSEIF POSS = 2 THEN
            Pack(POSS) = Pack(POSS) - 50
          ELSE
            Pack(POSS) = Pack(POSS) - 10
          END IF
         
          LOCATE POSS * 7 + 3, 50
          PRINT "                 "
          LOCATE POSS * 7 + 3, 50
          PRINT "["; Pack(POSS); "]"
        END IF
    END SELECT
 
  LOOP
SCREEN 13
EXIT SUB

END SUB


--