home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib34b.dsk / MOUSETRAP.bas < prev    next >
BASIC Source File  |  2023-02-26  |  9KB  |  144 lines
  1. 10  REM **********************
  2. 20  REM *     MOUSETRAP      * 
  3. 30  REM *  BY MIKE DORFFLER  *
  4. 40  REM * COPYRIGHT (C) 1988 *
  5. 50  REM * BY MICROSPARC, INC *
  6. 60  REM * CONCORD, MA  01742 *
  7. 70  REM ********************** 
  8. 80  HIMEM: 32768
  9. 90  ONERR  GOTO 1100
  10. 100  TEXT : HOME : PRINT  CHR$(21): IF  PEEK(48896) = 76  THEN  PRINT "MOUSETRAP RUNS UNDER DOS 3.3 ONLY!": END 
  11. 110  VTAB 8: HTAB 15: PRINT "MOUSETRAP": PRINT : HTAB 12: PRINT "BY MIKE DORFFLER": PRINT : HTAB 4: PRINT "COPYRIGHT 1988 BY MICROSPARC, INC.": PRINT : HTAB 10: PRINT "ONE MOMENT PLEASE..."
  12. 120 FIXERR = 32771:COPY = 32781:PUTBACK = 32788:DISPLAY = 32795:FRAME = 32798:CAPTURE = 32801:GITKEY = 32804:MARKER = 23104:PAGE1 = 62436:KLEAR = 62450:KSTACK = 62248:BELL = 65338:ESC = 975
  13. 130 DR = 1:EP = 0:K$ = "":D$ =  CHR$(4):BL$ = D$ +"BLOAD ":BS$ = D$ +"BSAVE ":CD$ = D$ +"CATALOG,D"
  14. 140 Z$ = " <- OR -> TO SELECT THEN PRESS <RETURN>"
  15. 150 W$ = "PRESS <RETURN> TO CONT -- <ESC> TO QUIT"
  16. 160 Y$ = " PRESS <RETURN> WITHOUT ENTRY TO CANCEL"
  17. 170 H$ = "     PRINTSHOP FORMAT     CAPTURE FORMAT": REM  5 SPACES BEFORE 'P' AND BETWEEN 'T' & 'C'
  18. 180  DIM C$(8),V(8),H(8): FOR J = 1 TO 8: READ C$(J): READ V(J): READ H(J): NEXT 
  19. 190  DATA   CATALOG,23,2,LOAD HR,24,2,LOAD PS,23,12,CAPTURE,24,12,CANCEL
  20. 200  DATA  23,23,SAVE,24,23,DRIVE,23,33,QUIT,24,33
  21. 210 ML = 1: PRINT : PRINT D$"BRUNMOUSETRAP.ML":ML = 0
  22. 220  POKE 230,32: CALL KLEAR: POKE 230,64: CALL KLEAR: POKE MARKER,206: POKE 43624,1:M = 1: GOTO 810
  23. 230  POKE  -16368,0: WAIT 49152,128:K =  PEEK(49152): POKE 49168,0:K = K -32 *(K >224  AND K <251): RETURN 
  24. 240  REM  **** SAVE PRINTSHOP PIC ****
  25. 250  ONERR  GOTO 1110
  26. 260  IF  PEEK(MARKER) < >217  THEN  CALL BELL: HOME : VTAB 22: PRINT "SORRY, NO PRINTSHOP PIC. NOW IN MEMORY": GOTO 1220
  27. 270  HOME : VTAB 21: INVERSE : PRINT Y$: NORMAL 
  28. 280  VTAB 23: HTAB 2: PRINT "PLACE DISK TO SAVE TO IN PROPER DRIVE": HTAB 4: PRINT "THEN PRESS DRIVE <1> OR DRIVE <2>";
  29. 290  GOSUB 230: IF K < >141  AND K < >177  AND K < >178  THEN 290
  30. 300  IF K = 141  THEN 710
  31. 310 DR = 1: IF K = 178  THEN DR = 2
  32. 320  HOME : VTAB 21: INVERSE : PRINT Y$: NORMAL : VTAB 22: PRINT "FILE NAME? ";: GOSUB 1310: IF K$ = ""  THEN M = 1: GOTO 810
  33. 330  IF  LEN(K$) >15  THEN  CALL BELL: VTAB 23: PRINT "SORRY, 15 CHARACTERS MAXIMUM": FOR P = 1 TO 2000: NEXT : GOTO 320
  34. 340  ONERR  GOTO 1110
  35. 350  VTAB 23: HTAB 1: PRINT " SAVING -> ";: INVERSE : PRINT K$: NORMAL : CALL  -998: PRINT : PRINT BS$;K$;",A$5800,L$240,D";DR
  36. 360  IF EP = 3  THEN 600
  37. 370 EP = 4: CALL PUTBACK: POKE MARKER,206:M = 1: GOTO 800
  38. 380  REM **** CATALOG DISK ****
  39. 390  ONERR  GOTO 1100
  40. 400  TEXT : HOME : PRINT : PRINT CD$;DR: PRINT : PRINT " <PRESS RETURN>": GOSUB 230: CALL PAGE1:M = 2: GOTO 810
  41. 410  REM **** LOAD HIRES PICTURE ****
  42. 420 HR = 1: ONERR  GOTO 1110
  43. 430  HOME : VTAB 21: INVERSE : PRINT Y$: NORMAL : VTAB 22: PRINT "LOAD WHICH PIC? ";: GOSUB 1310:HR = 0: IF K$ = ""  THEN M = 1: GOTO 810
  44. 440  VTAB 23: HTAB 6: PRINT "LOADING -> ";: INVERSE : PRINT K$: NORMAL 
  45. 450  CALL  -998: PRINT : PRINT BL$;K$;",A$2000,D";DR
  46. 460  IF ( PEEK(43617) *256 + PEEK(43616)) <8184  THEN  POKE 230,32: CALL KLEAR: HOME : CALL BELL: VTAB 22: INVERSE : PRINT K$;: NORMAL : PRINT " IS NOT A HIRES PICTURE":EP = 4: GOTO 1220
  47. 470  CALL COPY:M = 4: GOTO 810
  48. 480  REM **** LOAD PRINTSHOP PIC ****
  49. 490  ONERR  GOTO 1110
  50. 500  POKE 230,32: CALL KLEAR
  51. 510  HOME : VTAB 21: INVERSE : PRINT Y$: NORMAL : VTAB 23: PRINT "  LOAD PS FILE FROM DRIVE <1> OR <2>?"
  52. 520  GOSUB 230: IF K < >141  AND K < >177  AND K < >178  THEN 520
  53. 530  IF K = 141  THEN 710
  54. 540 DR = 1: IF K = 178  THEN DR = 2
  55. 550  HOME : VTAB 21: INVERSE : PRINT Y$: NORMAL : VTAB 22: PRINT "LOAD WHICH PS FILE? ";: GOSUB 1310: IF K$ = ""  THEN  POKE 230,32: CALL KLEAR: POKE MARKER,206:M = 1: GOTO 810
  56. 560  ONERR  GOTO 1110
  57. 570  VTAB 23: HTAB 10: PRINT "LOADING -> ";: INVERSE : PRINT K$: NORMAL : CALL  -998: PRINT : PRINT BL$;K$;",A$5800,D";DR
  58. 580  IF ( PEEK(43617) *256 + PEEK(43616)) >576  THEN  HOME : CALL BELL: VTAB 22: INVERSE : PRINT K$;: NORMAL : PRINT " IS NOT A PRINTSHOP PIC.":EP = 1: GOTO 1220
  59. 590  POKE MARKER,217: CALL DISPLAY
  60. 600  HOME : VTAB 21: INVERSE : PRINT Y$: NORMAL : VTAB 23: PRINT " SAVE PIC TO ANOTHER DISK? <Y>ES <N>O "
  61. 610  GOSUB 230: IF K < >141  AND K < >206  AND K < >217  THEN 610
  62. 620  IF K = 141  OR K = 206  THEN 680
  63. 630  VTAB 23: HTAB 2: PRINT "PLACE DISK TO SAVE TO IN PROPER DRIVE": HTAB 4: PRINT "THEN PRESS DRIVE <1> OR DRIVE <2>";
  64. 640  GOSUB 230: IF K < >141  AND K < >177  AND K < >178  THEN 640
  65. 650  IF K = 141  THEN  VTAB 23: HTAB 1: CALL  -958: GOTO 680
  66. 660 DR = 1: IF K = 178  THEN DR = 2
  67. 670 EP = 3: GOTO 320
  68. 680  VTAB 23: HTAB 2: PRINT "LOAD ANOTHER PRINTSHOP PIC? <Y>ES <N>O"
  69. 690  GOSUB 230: IF K < >141  AND K < >206  AND K < >217  THEN 690
  70. 700  IF K = 217  THEN 510
  71. 710  POKE 230,32: CALL KLEAR: POKE 230,64: CALL KLEAR: POKE MARKER,206:M = 1: GOTO 820
  72. 720  REM **** END PROGRAM ****
  73. 730  POKE 43624,1: TEXT : HOME : PRINT "ARE YOU SURE YOU WANT TO QUIT? ";: POKE  -16368,0: GET A$: IF A$ < >"Y"  AND A$ < >"y"  THEN M = 1: GOTO 810
  74. 740  HOME : VTAB 23: END 
  75. 750  REM **** DELETE PS PICTURE ****
  76. 760  CALL PUTBACK: POKE MARKER,206:M = 4: GOTO 810
  77. 770  REM **** CHANGE DRIVE SOURCE ****
  78. 780 DR = DR +(DR = 1) -(DR = 2): POKE 43624,DR
  79. 790  VTAB V(7): HTAB H(7) +6: PRINT DR;: GOTO 840
  80. 800  REM **** MAIN MENU ****
  81. 810  CALL PAGE1
  82. 820  HOME : POKE 49235,0: VTAB 21: INVERSE : PRINT Z$: NORMAL 
  83. 830  FOR J = 1 TO 8: VTAB V(J): HTAB H(J): PRINT C$(J);: NEXT : VTAB V(7): HTAB H(7) +6: PRINT DR;
  84. 840  GOSUB 860
  85. 850  ON M GOTO 380,410,480,940,750,250,770,720
  86. 860  INVERSE : VTAB V(M): HTAB H(M): PRINT C$(M);: NORMAL : GOSUB 230: IF K = 136  OR K = 139  THEN  GOSUB 900
  87. 870  IF K = 149  OR K = 138  THEN  GOSUB 920
  88. 880  IF K < >141  THEN 860
  89. 890  RETURN 
  90. 900  VTAB V(M): HTAB H(M): PRINT C$(M);:M = M -1: IF M <1  THEN M = 8
  91. 910  INVERSE : VTAB V(M): HTAB H(M): PRINT C$(M);: NORMAL : RETURN 
  92. 920  VTAB V(M): HTAB H(M): PRINT C$(M);:M = M +1: IF M >8  THEN M = 1
  93. 930  INVERSE : VTAB V(M): HTAB H(M): PRINT C$(M);: NORMAL : RETURN 
  94. 940  REM **** CAPTURE ROUTINE ****
  95. 950  CALL PUTBACK: POKE MARKER,206: HOME : VTAB 21: INVERSE : PRINT Y$: NORMAL : VTAB 23: HTAB 4: PRINT "CAPTURE BY <M>OUSE OR <K>EYBOARD?"
  96. 960  GOSUB 230: POKE ESC,0: IF K < >141  AND K < >205  AND K < >203  THEN 960
  97. 970  IF K = 141  THEN M = 1: GOTO 820
  98. 980  IF K = 203  THEN  HOME : CALL GITKEY: GOTO 1060
  99. 990  POKE 49234,0: PRINT : PRINT D$"PR#4": PRINT  CHR$(1): PRINT D$"PR#0": PRINT D$"IN#4"
  100. 1000  INPUT "";X,Y,S: IF S = 2  THEN A = 1: CALL CAPTURE: GOTO 1050
  101. 1010  IF S <0  THEN A = 2: GOTO 1050
  102. 1020 X =  INT(X *.917): IF X >191  THEN X = 191
  103. 1030 Y =  INT(Y *.893): IF Y >140  THEN Y = 140
  104. 1040  POKE 244,X: POKE 245,0: POKE 246,Y: CALL FRAME: GOTO 1000
  105. 1050  PRINT : PRINT D$"IN#0": PRINT D$"PR#4": PRINT  CHR$(0): PRINT D$"PR#0": IF A = 2  THEN 1090
  106. 1060  POKE  -16301,0: IF  PEEK(ESC) < >155  THEN  HOME : VTAB 21: INVERSE : PRINT H$: NORMAL : VTAB 23: HTAB 7: PRINT "PRESS <RETURN> TO CONTINUE": GOTO 1080
  107. 1070 M = 4: GOTO 810
  108. 1080  GOSUB 230:M = 6: GOTO 810
  109. 1090  POKE 49168,0:M = 4: GOTO 810
  110. 1100  REM **** ERROR HANDLING ROUTINE ****
  111. 1110  CALL BELL: IF ML = 1  THEN 1300
  112. 1120  CALL FIXERR:ERR =  PEEK(222)
  113. 1130 LINERR =  PEEK(219) *256 + PEEK(218): CALL KSTACK: POKE 216,0
  114. 1140  HOME : CALL PAGE1: VTAB 22
  115. 1150  IF ERR = 6  OR ERR = 13  THEN  PRINT "SORRY, ";: INVERSE : PRINT K$: NORMAL 
  116. 1160  IF ERR = 6  THEN  PRINT "NOT ON DISK IN DRIVE ";DR: GOTO 1220
  117. 1170  IF ERR = 13  THEN  PRINT "IS NOT A BINARY FILE": GOTO 1220
  118. 1180  IF ERR = 4  THEN  PRINT "DISK IN DRIVE ";DR;" IS WRITE PROTECTED": GOTO 1220
  119. 1190  IF ERR = 8  THEN  PRINT "I/O ERROR--CHECK DRIVE DOOR": GOTO 1220
  120. 1200  IF ERR = 9  THEN  PRINT "SORRY, DISK DIRECTORY IS FULL": GOTO 1220
  121. 1210  TEXT : HOME : VTAB 20: PRINT "YOU HAVE AN ERROR IN LINE #";LINERR: END 
  122. 1220  PRINT W$;
  123. 1230  GOSUB 230: IF K < >155  AND K < >141  THEN 1230
  124. 1240  IF K = 155 GOTO 730
  125. 1250  IF EP = 4  THEN M = 2: GOTO 820
  126. 1260  IF EP = 1  THEN  POKE MARKER,206:M = 1: GOTO 820
  127. 1270  IF M = 6  THEN 820
  128. 1280  POKE 230,32: CALL KLEAR:M = 1: GOTO 820
  129. 1290  POKE MARKER,206:M = 1: GOTO 820
  130. 1300  TEXT : HOME : VTAB 20: PRINT "SORRY, THE MOUSETRAP.ML FILE IS NOT": PRINT "ON THIS DISK. THE MOUSETRAP PROGRAM": PRINT "CANNOT CONTINUE.": END 
  131. 1310 L = 15:CH =  PEEK(36):CV =  PEEK(37): IF HR  THEN L = 23
  132. 1320  FOR LI = 1 TO L: PRINT "_";: NEXT : FOR LI = 1 TO L: PRINT  CHR$(8);: NEXT :LI = 0:K$ = ""
  133. 1330  POKE  -16368,0
  134. 1340 K =  PEEK( -16384): IF K <128  THEN 1340
  135. 1350  IF K = 141  THEN  FOR J = LI TO L: PRINT " ";: NEXT : RETURN :: REM   RETURN KEY
  136. 1360  IF K = 155  THEN  VTAB CV +1: HTAB CH +1: GOTO 1310
  137. 1370  IF K = 136  AND LI = 0  THEN  PRINT  CHR$(7);: GOTO 1330
  138. 1380  IF K = 136  AND LI = 1  THEN  PRINT  CHR$(136);: PRINT "_";: PRINT  CHR$(136);:LI = LI -1:K$ = "": GOTO 1330
  139. 1390  IF K = 136  THEN  PRINT  CHR$(136);: PRINT "_";: PRINT  CHR$(136);:LI = LI -1:K$ =  LEFT$(K$,LI): GOTO 1330
  140. 1400  IF LI = L  THEN  PRINT  CHR$(7);: GOTO 1330
  141. 1410  IF K <160  THEN 1330
  142. 1420  IF K >224  THEN K = K -32
  143. 1430  PRINT  CHR$(K);:K$ = K$ + CHR$(K):LI = LI +1: GOTO 1330
  144. 1440  PRINT : RETURN