home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib22b.dsk / HI.RES.SKETCHER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  8KB  |  94 lines

  1. 10  REM  ************************
  2. 20  REM  *    HI.RES.SKETCHER   *
  3. 30  REM  *      BY TIM LORS     *
  4. 40  REM  *  COPYRIGHT (C) 1984  *
  5. 50  REM  *  BY MICROSPARC, INC  *
  6. 60  REM  *  CONCORD, MA. 01742  *
  7. 70  REM  ************************
  8. 80  HOME : HGR : GOTO 380
  9. 90 M = 1:H = 2: HCOLOR= 2: POKE  -16297,0: POKE  -16304,0: ROT= 1: SCALE= 1
  10. 100 J = 159 - PDL(1)/1.6 -(255 - PDL(3))/3: IF J <0  THEN J = 0
  11. 110 I =  PDL(0)/.9 +1 +(255 - PDL(2))/2: IF I >278  THEN I = 278
  12. 120  VTAB 24: HTAB 10: PRINT "X=" INT(I)"  ";: HTAB 18: PRINT "Y=" INT(J)"  ";: IF M >0  THEN X = I:Y = J
  13. 130  XDRAW 1 AT I,J:E = 159 - PDL(1)/1.6 -(255 - PDL(3))/3: IF E <0  THEN E = 0
  14. 140 D =  PDL(0)/.9 +1 +(255 - PDL(2))/2: IF D >278  THEN D = 278
  15. 150  IF  PEEK( -16384) = 205  THEN  TEXT : GET A$: XDRAW 1 AT I,J: GOTO 420
  16. 160  IF  PEEK( -16384) = 195  THEN  GET A$: HGR : GOTO 100
  17. 170  IF  PEEK( -16287) >127  THEN M =  -M: GOSUB 220
  18. 180  IF  PEEK( -16286) >127  THEN  XDRAW 1 AT I,J:H = H +1: GOTO 250
  19. 190  IF H = 8  THEN  XDRAW 1 AT I,J:X = I:Y = J: GOTO 100
  20. 200  IF M <0  THEN  XDRAW 1 AT I,J: GOTO 100
  21. 210  XDRAW 1 AT I,J:T = X +1:L = D +1: HPLOT X,Y TO D,E TO T,Y TO L,E TO X,Y:J = E:I = D: GOTO 120
  22. 220  VTAB 23: HTAB 1: IF M >0  THEN  PRINT "       ";
  23. 230  IF M <0  THEN  PRINT "WAIT TO";
  24. 240  FOR Q = 1 TO 300: NEXT : RETURN 
  25. 250  VTAB 23: HTAB 11: IF H = 9  THEN H = 0
  26. 260  PRINT H$(H);: IF H < >8  THEN  HCOLOR= H
  27. 270  FOR Q = 1 TO 500: NEXT : GOTO 120
  28. 280  PRINT : PRINT D$"OPEN"P$: PRINT D$"READ"P$: INPUT Z$:A =  VAL(Z$): FOR Z = 1 TO A: INPUT P$(Z): NEXT : PRINT D$"CLOSE":P$(0) =  STR$(A)
  29. 290  IF F  THEN 340
  30. 300  GOTO 580
  31. 310  PRINT : PRINT D$"OPEN"P$: PRINT D$"WRITE"P$: FOR Q = 0 TO  VAL(P$(0)): PRINT P$(Q): NEXT : PRINT D$"CLOSE": IF F = 7  THEN 870
  32. 320  GOTO 420
  33. 330  HOME :F = 1: GOTO 280
  34. 340  IF P$(0) = "0"  THEN  RUN 
  35. 350  HOME : FOR Z = 1 TO  VAL(P$(0)): PRINT "("Z") "P$(Z): NEXT : PRINT : PRINT "PLEASE ENTER NUMBER & PRESS 'RETURN' ?";: HTAB  POS(0): INPUT "";A$: IF A$ = ""  OR A$ = "0"  THEN 420
  36. 360 A =  VAL(A$): IF A <1  OR A > VAL(P$(0))  THEN  PRINT  CHR$(7): PRINT : GOTO 350
  37. 370  RETURN 
  38. 380  NORMAL : LOMEM: 16384
  39. 390  DIM P$(20): ONERR  GOTO 770
  40. 400 H$(0) = "0 - BLACK  ":H$(1) = "1 - GREEN  ":H$(2) = "2 - PURPLE ":H$(3) = "3 - WHITE  ":H$(4) = "4 - BLACK  ":H$(5) = "5 - ORANGE ":H$(6) = "6 - BLUE   ":H$(7) = "7 - WHITE":H$(8) = "TRANSPARENT"
  41. 410  FOR F = 768 TO 778: READ Z: POKE F,Z: NEXT : POKE 232,0: POKE 233,3:D$ =  CHR$(4):P$ = "PIC.NAMESFILE": DATA  1,0,4,0,60,54,45,36,55,38,0
  42. 420  TEXT : HOME :F = 0: VTAB 2: HTAB 12: PRINT "HI-RES SKETCHER": HTAB 19: PRINT "BY": HTAB 16: PRINT "TIM LORS": VTAB 22: PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **": VTAB 9
  43. 430  PRINT "YOU MAY: (1) CREATE A DRAWING": POKE 32,9: PRINT : PRINT "(2) STORE DRAWING JUST CREATED": PRINT : PRINT "(3) DISPLAY A STORED DRAWING": PRINT : PRINT "(4) DELETE A DRAWING": PRINT : PRINT "(5) EXIT THIS PROGRAM": PRINT : PRINT "WHICH?";
  44. 440  GET A$: TEXT : HOME : POKE 51,6: IF A$ =  CHR$(27)  OR A$ = "5"  THEN  POKE 216,0: END 
  45. 450 A =  VAL(A$): IF A <1  OR A >4  THEN 420
  46. 460  ON A GOTO 470,530,690,700
  47. 470  PRINT "PADDLE 0 - DRAW HORIZONTALLY": PRINT : PRINT "PADDLE 1 - DRAW VERTICALLY"
  48. 480  PRINT : PRINT "BUTTON 0 - DRAW DIAGONAL LINES": PRINT "   FIRST PRESS STARTS LINE": PRINT "   SECOND PRESS ENDS LINE"
  49. 490  PRINT : PRINT "BUTTON 1 - CHANGE COLORS:": POKE 32,5: PRINT : FOR Q = 0 TO 3: PRINT H$(Q); SPC( 5);H$(Q +4): NEXT : PRINT H$(8): POKE 32,0: PRINT 
  50. 500  PRINT "C - CLEAR SCREEN": PRINT : PRINT "M -  RETURN  TO MENU"
  51. 510  VTAB 22: HTAB 5: PRINT "<PRESS ANY KEY TO CONTINUE>";
  52. 520  GET A$: HOME : VTAB 22: PRINT "MODE       ----------     'M'      'C'": HTAB 11: PRINT H$(2);: HTAB 26: PRINT "FOR    TO CLEARDRAW" SPC( 21)"MENU    SCREEN";: GOTO 90
  53. 530  VTAB 12: PRINT "THIS DRAWING NEEDS A NAME.": PRINT "PLEASE TYPE ONE NOW AND PRESS 'RETURN'. ": PRINT "NAME ";: INPUT A$: IF  LEN(A$) = 0  THEN 420
  54. 540  CALL  -958: PRINT : PRINT : PRINT : IF  ASC(A$) <65  THEN  PRINT "THE NAME MUST BEGIN WITH A LETTER !!!": GOTO 530
  55. 550  IF  ASC( RIGHT$(A$,1)) <33  THEN A$ =  LEFT$(A$, LEN(A$) -1): GOTO 550
  56. 560  IF  LEN(A$) >30  THEN  CALL  -958:A$ =  LEFT$(A$,30): PRINT : PRINT : PRINT : PRINT "THAT'S TOO LONG !!!": PRINT : PRINT "WOULD IT BE OK TO SHORTEN THE NAME TO   ";A$;" ? (Y/N)";: HTAB 32: GET Z$: PRINT : IF Z$ < >"Y"  THEN  HOME : GOTO 530
  57. 570 F = 0: GOTO 280
  58. 580  FOR Q = 1 TO  VAL(P$(0)): IF A$ = P$(Q)  THEN F = 1:Q =  VAL(P$(0))
  59. 590  NEXT : IF F  THEN  CALL  -958: VTAB 20: PRINT "THERE IS ALREADY A FILE BY THE NAME": PRINT A$: PRINT : PRINT "SHOULD THIS DRAWING REPLACE IT ? (Y/N)";: HTAB 32: GET Z$:F = 2: HOME : IF Z$ < >"Y"  THEN 530
  60. 600  IF F < >2  THEN  PRINT D$"VERIFY"A$: HOME : VTAB 5: PRINT "SORRY, BUT THAT FILE NAME IS ALREADY    IN USE ON THIS DISKETTE.": GOTO 530
  61. 610  PRINT : PRINT : PRINT "STORING "A$: PRINT D$"BSAVE "A$",A$2000,L$1FF8": IF F = 2  THEN 420
  62. 620 P$( VAL(P$(0)) +1) = A$:P$(0) =  STR$( VAL(P$(0)) +1): IF  VAL(P$(0)) = 1  THEN 680
  63. 630 F = 0:I = 1
  64. 640  IF P$(I) < = P$(I +1)  THEN 660
  65. 650 T$ = P$(I +1):P$(I +1) = P$(I):P$(I) = T$:F = 1
  66. 660 I = I +1: IF I < VAL(P$(0))  THEN 640
  67. 670  IF F  THEN 630
  68. 680  GOTO 310
  69. 690  GOSUB 330: HOME : PRINT D$"BLOAD "P$(A): VTAB 24: PRINT "PRESS ANY KEY TO RETURN TO THE MENU ";: POKE  -16297,0: POKE  -16304,0: GET A$: TEXT : GOTO 420
  70. 700  GOSUB 330: HOME 
  71. 710  VTAB 12: HTAB 12: PRINT "ONCE YOU DELETE": PRINT : PRINT : PRINT : INVERSE : HTAB (40 - LEN(P$(A)))/2: PRINT " "P$(A)" ": PRINT : NORMAL 
  72. 720  HTAB 8: PRINT  CHR$(7) CHR$(7)"IT IS GONE - FOREVER !!!" CHR$(7) CHR$(7) CHR$(7): VTAB 24: PRINT "ARE YOU SURE YOU WANT TO DELETE IT ?";: HTAB  POS(0): GET A$: IF A$ < >"Y"  THEN 420
  73. 730  PRINT : PRINT :P$(0) =  STR$( VAL(P$(0)) -1):Z$ = P$(A): IF F < >7  THEN  PRINT "DELETING "P$(A)
  74. 740  IF A > VAL(P$(0))  THEN 760
  75. 750  FOR Q = A TO  VAL(P$(0)):P$(Q) = P$(Q +1): NEXT 
  76. 760  PRINT D$"DELETE "Z$: GOTO 310
  77. 770  PRINT D$"CLOSE":R =  PEEK(222):L =  PEEK(218) + PEEK(219) *256: IF R = 8  THEN  HOME : VTAB 12: PRINT "FIX THE DISK & PRESS 'RETURN' ";: GET A$: GOTO 420
  78. 780  IF R = 5  THEN  PRINT D$"CLOSE":P$(0) = "0": GOTO 290
  79. 790  IF R = 10  AND L = 310  THEN  PRINT D$"UNLOCK "P$: GOTO 310
  80. 800  IF R = 10  THEN  HOME : VTAB 7: PRINT "THERE IS A FILE BY THAT NAME ALREADY,   AND IT HAPPENS TO BE LOCKED !!!": PRINT 
  81. 810  IF R = 10  AND L = 600  THEN  VTAB 5: PRINT  SPC( 8)"(USE A DIFFERENT NAME)" CHR$(7): GOTO 530
  82. 820  IF R = 10  THEN  PRINT "SHOULD IT BE UNLOCKED & WRITTEN OVER ?";: HTAB  POS(0): GET Z$: PRINT : IF Z$ = "Y"  THEN  PRINT D$"UNLOCK"A$: GOTO 610
  83. 830  IF R = 10  THEN 530
  84. 840  IF R = 9  AND L = 310  THEN  FOR Q = 1 TO  VAL(P$(0)): IF A$ = P$(Q)  THEN A = Q
  85. 850  IF R = 9  AND L = 310  THEN  NEXT :F = 7: PRINT D$"DELETE"P$: GOTO 730
  86. 860  IF R = 9  THEN  PRINT D$"DELETE"A$
  87. 870  IF R = 9  THEN  HOME : FLASH : PRINT  SPC( 10)"THE DISK IS FULL !!!" SPC( 10): NORMAL : VTAB 12: PRINT "DO YOU WANT TO TRY ANOTHER DISKETTE ?";: HTAB  POS(0): GET Z$: PRINT : PRINT 
  88. 880  IF R = 9  AND Z$ = "Y"  THEN  PRINT "PRESS ANY KEY TO BEGIN ANOTHER ATTEMPT !";: HTAB  POS(0): GET Z$: GOTO 560
  89. 890  IF R = 9  THEN  PRINT "DO YOU WISH TO RETURN TO THE MENU ?";: HTAB  POS(0): GET Z$: IF Z$ < >"Y"  THEN 870
  90. 900  IF R = 9  THEN  HOME : VTAB 12: PRINT "IF YOU ARE INTENDING TO EXIT, MAKE ROOM ON THIS DISKETTE, AND THEN TRY AGAIN TO STORE THIS DRAWING. YOU SHOULD TYPE     'GOTO 420' TO RESTART THE PROGRAM.": FOR Q = 1 TO 9999: NEXT : GOTO 420
  91. 910  IF R = 6  AND L = 690  THEN  HOME : VTAB 12: PRINT "THAT DRAWING IS NOT ON THIS DISKETTE ???": VTAB 19: GOTO 730
  92. 920  IF R = 6  AND L = 760  THEN 310
  93. 930  IF R = 6  AND L = 600  THEN 610
  94. 940  IF R = 6  AND L = 860  THEN R = 9: GOTO 870