home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / friendly / draw.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-25  |  11.4 KB  |  172 lines
  1. 10 WIDTH 80:SCREEN 0,0,0:DEF SEG=&H40:POKE &H17,(PEEK(&H17) AND 64):O%=0:CLRBUF%=0
  2. 20 ON KEY(10) GOSUB 1380:DEFSTR Z:XT$="A:":GOSUB 1520
  3. 30 CLS:DIM NAMES$(1)
  4. 40 ON KEY(1) GOSUB 950:ON KEY(2) GOSUB 1060:ON KEY(3) GOSUB 930:ON KEY(4) GOSUB 940:ON KEY(5) GOSUB 1020:ON KEY(6) GOSUB 1460:ON KEY(7) GOSUB 1050:ON KEY(8) GOSUB 1050:ON KEY(9) GOSUB 1050
  5. 50 DEF SEG=&H40:IF (PEEK(&H10) AND 48)=48 THEN VIDEO%=&HB000 ELSE VIDEO%=&HB800
  6. 60 LOCATE ,,1,5,7
  7. 70 GOSUB 1080
  8. 80 COLOR 7,0
  9. 90 GOSUB 310
  10. 100 GOSUB 280
  11. 110 GOSUB 1120
  12. 120 X=12:Y=40:LOCATE X,Y,1
  13. 130 FOR SS=1 TO 10:KEY(SS) ON:NEXT:DEF SEG:POKE 106,0
  14. 140 Z=INKEY$:IF Z="" THEN 140
  15. 150 Z1=MID$(Z,2,1):IF LEN(Z)>1 THEN 210
  16. 160 IF FLAG OR Z=" " THEN PRINT Z;:Y=Y+1:GOSUB 340:GOTO 130
  17. 170 IF Z<"A" OR Z>"Y" THEN 190
  18. 180 LOCATE X,Y:PRINT CHR$(ARRAY%(1,ASC(Z)-64));:Y=Y+1:GOSUB 340:GOTO 130
  19. 190 IF Z<"a" OR Z>"y" THEN 210
  20. 200 LOCATE X,Y:PRINT CHR$(ARRAY%(0,ASC(Z)-96));:Y=Y+1:GOSUB 340:GOTO 130
  21. 210 IF Z1=CHR$(72) THEN X=X-1 ELSE IF Z1=CHR$(75) THEN Y=Y-1 ELSE IF Z1=CHR$(77) THEN Y=Y+1 ELSE IF Z1=CHR$(80) THEN X=X+1 ELSE IF Z1=CHR$(115) THEN Y=Y-10 ELSE IF Z1=CHR$(116) THEN Y=Y+10 ELSE IF Z1=CHR$(73) THEN X=X-5 ELSE IF Z1=CHR$(81) THEN X=X+5
  22. 220 IF Z1=CHR$(71) THEN X=1:Y=1 ELSE IF Z1=CHR$(79) THEN Y=80 ELSE IF Z1=CHR$(119) THEN GOSUB 1120:CLS:LOCATE 12,40,1:X=CSRLIN:Y=POS(0):GOSUB 310:GOSUB 280 ELSE IF Z1=CHR$(31) THEN GOSUB 700:GOTO 260 ELSE IF Z1=CHR$(38) THEN GOSUB 760:GOTO 260
  23. 230 IF Z1=CHR$(37) THEN GOSUB 1130:GOTO 260 ELSE IF Z1=CHR$(33) THEN GOSUB 330:GOTO 260 ELSE IF Z1=CHR$(46) THEN GOSUB 390:GOTO 260 ELSE IF Z1=CHR$(118) THEN GOSUB 300 ELSE IF Z1=CHR$(132) THEN GOSUB 280
  24. 240 IF Z1=CHR$(32) THEN GOSUB 1500 ELSE IF Z=CHR$(8) THEN PRINT CHR$(29)" "CHR$(29);:Y=Y-1
  25. 250 GOSUB 340:LOCATE X,Y,1:GOTO 130
  26. 260 IF FLAG THEN GOSUB 300 ELSE GOSUB 280
  27. 270 GOTO 250
  28. 280 R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480:LOCATE 23,1:PRINT"UPPER"CHR$(29);:FOR A=1 TO 25:LOCATE ,POS(0)+2:PRINT CHR$(ARRAY%(1,A));:NEXT:LOCATE 24,5
  29. 290 FOR A=1 TO 25:LOCATE ,POS(0)+2:PRINT CHR$(A+64);:NEXT:LOCATE 25,1:PRINT"LOWER"CHR$(29);:FOR A=1 TO 25:LOCATE ,POS(0)+2:PRINT CHR$(ARRAY%(0,A));:NEXT:FLAG=0:RETURN
  30. 300 R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480:LOCATE 25,22:PRINT"You Are In AlphaNumeric Character Set";:FLAG=1:RETURN
  31. 310 CLS:COLOR 0,7:PRINT" <F1> Instructions & Special Commands          <F4> Saves This Picture  To Disk ";:PRINT" <F2> Runs Previous Picture (memory)           <F5> Alternates Graphics/Letters ";
  32. 320 PRINT" <F3> Loads a Picture From Disk    <F6> Clear Screen   <F10> Leave This Program ":COLOR 7,0:RETURN
  33. 330 F=0:LOCATE ,1:CLOSE:OPEN"I",1,XT$+"PICTURE.FLE":WHILE EOF(1)=0:INPUT#1,ZA:PRINT LEFT$(ZA,8),:WEND:CLOSE:RETURN
  34. 340 IF X>22 THEN X=22
  35. 350 IF X<4 THEN X=4
  36. 360 IF Y>80 THEN IF X<22 THEN X=X+1:Y=Y-80:RETURN ELSE Y=80:RETURN
  37. 370 IF Y<1 THEN IF X>4 THEN X=X-1:Y=Y+80 ELSE Y=1
  38. 380 ON ERROR GOTO 490:RETURN
  39. 390 R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480:LOCATE 25,1:PRINT"WHAT COLORS WOULD YOU LIKE? <No,No>";
  40. 400 Z1="":Z=""
  41. 410 Z1=INKEY$:IF Z1="" THEN 410
  42. 420 IF Z1="," THEN F=VAL(Z):PRINT",";:GOTO 400
  43. 430 IF Z1=CHR$(13) THEN 480
  44. 450 IF Z1=CHR$(8) THEN 470
  45. 460 Z=Z+Z1:PRINT Z1;:GOTO 410
  46. 470 IF LEN(Z)<1 THEN 410 ELSE PRINT CHR$(29)" "CHR$(29);:Z=LEFT$(Z,LEN(Z)-1):GOTO 410
  47. 480 F1=VAL(Z):IF F1>7 OR F>31 THEN 390 ELSE GOSUB 280:COLOR F,F1:RETURN
  48. 490 IF ERR=61 THEN ER$="Diskette Is Full. File Not Saved.":GOTO 640
  49. 500 IF ERR=53 AND ERL=1470 THEN ER$="Insert FriendlyWare Diskette No.2":GOTO 610
  50. 510 IF ERR=53 THEN ER$="File Was Not Found":GOTO 640
  51. 520 IF ERR=64 THEN ER$="Bad File Name":GOTO 640
  52. 530 IF ERR=67 THEN ER$="Too Many Diskette Files":GOTO 640
  53. 540 IF ERR=70 THEN ER$="Diskette Is Write Protected":GOTO 640
  54. 550 IF ERR=71 THEN ER$="Close Disk Drive Cover":GOTO 640
  55. 560 IF ERR=72 THEN ER$="Disk Media Error":GOTO 640
  56. 570 IF ERR=52 THEN ER$="Bad File Name":GOTO 640
  57. 580 IF ERR=76 THEN ER$="File Was Not Found":GOTO 640
  58. 590 ON ERROR GOTO 0
  59. 600 END
  60. 610 R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480:LOCATE 24,(80-LEN(ER$))/2:PRINT ER$;:LOCATE 25,30:PRINT"And Strike Any Key To Continue";
  61. 620 IF INKEY$<>"" THEN 620
  62. 630 Z=INKEY$:IF Z="" THEN 630 ELSE RESUME 1470
  63. 640 R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480:LOCATE 24,(80-LEN(ER$))/2:PRINT ER$;:LOCATE 25,15:PRINT"Your Command Was Aborted. Strike Any Key To Try Again.";
  64. 650 IF INKEY$<>"" THEN 650 ELSE DEF SEG=VIDEO%
  65. 660 Z=INKEY$:IF Z="" THEN 660
  66. 670 F=1:R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480
  67. 680 RESUME 690
  68. 690 RETURN
  69. 700 'SAVE A SCREEN
  70. 710 R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480
  71. 720 GOSUB 1120:LOCATE 24,10:PRINT"And Then Strike The Enter Key ";:LOCATE 23,10:PRINT"Please Enter A Name For This Picture ";:GOSUB 800:IF ZA="        " THEN 710 ELSE KEEP$=ZA
  72. 730 CLOSE:OPEN XT$+"PICTURE.FLE" FOR INPUT AS #1:WHILE EOF(1)=0:INPUT#1,ZA:IF LEFT$(KEEP$,8)=ZA THEN 750
  73. 740 WEND:CLOSE:OPEN XT$+"PICTURE.FLE" FOR APPEND AS #1:WRITE#1,KEEP$
  74. 750 CLOSE:KEEP$=XT$+KEEP$+".pic":DEF SEG=VIDEO%:BSAVE KEEP$,480,3040:GOSUB 310:RETURN
  75. 760 GOSUB 1120:GOSUB 310:LOCATE 4,1
  76. 770 CLOSE:OPEN "I",1,XT$+"PICTURE.FLE":WHILE EOF(1)=0:INPUT#1,LO$:PRINT LEFT$(LO$,8)" ";:WEND
  77. 780 LOCATE 24,10:PRINT"And Then Strike The Enter Key ";:LOCATE 23,10:PRINT"Please Enter The Name Of The Picture You'd Like To See ";:GOSUB 800
  78. 790 KEEP$=XT$+ZA+".pic":DEF SEG=VIDEO%:BLOAD KEEP$,480:RETURN
  79. 800 ZH=""
  80. 810 DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 810
  81. 820 ZI=INKEY$:IF ZI="" THEN 820
  82. 830 IF ZI=CHR$(13) THEN ZA=SPACE$(8):LSET ZA=ZH:RETURN
  83. 840 IF ZI=CHR$(8) THEN 900
  84. 850 IF LEN(ZI)>1 THEN IF RIGHT$(ZI,1)=CHR$(75) THEN 900 ELSE 810
  85. 860 IF LEN(ZH)>7 THEN 820
  86. 870 IF ZI<"a" OR ZI>"z" THEN 890
  87. 880 ZI=CHR$(ASC(ZI)-32)
  88. 890 ZH=ZH+ZI:PRINT ZI;:GOTO 820
  89. 900 IF LEN(ZH)<1 THEN 820
  90. 910 PRINT CHR$(29)" "CHR$(29);:ZH=LEFT$(ZH,LEN(ZH)-1):GOTO 820
  91. 920 KEY(1) OFF:KEY(3) OFF:KEY(4) OFF:Z=CHR$(0)+CHR$(33):RETURN 150
  92. 930 FOR A=1 TO 10:KEY(A) OFF:NEXT:Z=CHR$(0)+CHR$(38):RETURN 150
  93. 940 FOR A=1 TO 10:KEY(A) OFF:NEXT:Z=CHR$(0)+CHR$(31):RETURN 150
  94. 950 FOR A=1 TO 10:KEY(A) OFF:NEXT:DEF SEG=VIDEO%:BSAVE XT$+"tempory.tmp",480,3040
  95. 960 CLS:PRINT TAB(29)"DRAW COMMANDS and CONTROLS":PRINT TAB(18)"Alt & K.............To Erase A Picture From Files":PRINT TAB(18)"Cursor Arrows.......Moves Cursor In Any Direction":PRINT TAB(18)"Ctrl & Arrow Left...Moves Cursor Left  10  spaces
  96. 970 PRINT TAB(18)"Ctrl & Arrow Right..Moves Cursor Right 10  spaces":PRINT TAB(18)"PgUp................Moves Cursor  Up    5   Lines":PRINT TAB(18)"PgDn................Moves Cursor Down   5   Lines
  97. 980 PRINT TAB(18)"End.................Moves Cursor To End  Of  Line":PRINT TAB(18)"Home................Moves Cursor Home, Upper Left":PRINT TAB(18)"Alt & C.............Color Command, Enter No. , No.
  98. 990 PRINT TAB(18)"(The First Is Foreground And Second Is Background)":PRINT:PRINT TAB(18)"Alt & D............Allows you to select data drive and":PRINT TAB(37)"configure program for hard disk.":LOCATE 25,27:PRINT"Strike Any Key To Continue";
  99. 1000 A$=INKEY$:IF A$="" THEN 1000
  100. 1010 GOSUB 310:GOSUB 280:DEF SEG=VIDEO%:BLOAD XT$+"tempory.tmp",480:LOCATE X,Y,1:RETURN
  101. 1020 FOR A=1 TO 10:KEY(A) OFF:NEXT
  102. 1030 IF FLAG THEN GOSUB 280 ELSE GOSUB 300
  103. 1040 FOR A=1 TO 10:KEY(A) ON:NEXT:LOCATE X,Y,1:RETURN
  104. 1050 RETURN
  105. 1060 CLS:FX%=1:GOSUB 1490:RETURN 260
  106. 1070 LOCATE X,Y:RETURN
  107. 1080 DIM A%(21),B%(20),C%(3522),ARRAY%(1,25):FOR I=0 TO 21:READ A%(I):NEXT:FOR A=0 TO 1:FOR B=1 TO 25:READ ARRAY%(A,B):NEXT:NEXT:FOR I=0 TO 20:READ B%(I):NEXT:RETURN
  108. 1090 DATA &h8b55,&hb8ec,&h0600,&h07b7,&h768b,&h8a0c,&h8b2c,&h0a76,&h0c8a,&h768b,&h8a08,&h8b34,&h0676,&h148a,&hcdfe,&hc9fe,&hcefe,&hcafe,&h10cd,&hca5d,&h8,&h0
  109. 1100 DATA 200,188,186,202,185,197,192,217,179,193,180,177,176,221,220,17,27,174,25,249,250,157,4,5,2,201,187,205,203,204,206,218,191,196,194,195,219,178,222,223,16,26,175,24,15,248,247,6,3,1
  110. 1110 DATA &h8B55,&h1EEC,&h8B06,&H0A76,&h0C8B,&h7E8B,&h8B08,&h0676,&h8EAD,&h33D8,&h22F6,&h74C9,&h8706,&h1EF7,&h1F06,&hB907,&h0DC0,&hA4F3,&h1F07,&hCA5D,&H0006
  111. 1120 FX%=0:GOSUB 1490:RETURN
  112. 1130 FOR A=1 TO 9:KEY(A) OFF:NEXT
  113. 1140 GOSUB 1120:CLS:GOSUB 310:LOCATE 5,1
  114. 1150 CLOSE:OPEN XT$+"picture.fle" FOR INPUT AS #1
  115. 1160 ERASE NAMES$:DIM NAMES$(150)
  116. 1170 A=0
  117. 1180 WHILE EOF(1)=0:INPUT#1,NAMES$(A):PRINT LEFT$(NAMES$(A),8)"  ";:A=A+1:WEND
  118. 1190 R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480
  119. 1200 LOCATE 24,10:PRINT"And Then Strike The Enter Key ";
  120. 1210 LOCATE 23,10:PRINT"Please Enter Name Of Picture That You Wish To Erase ";
  121. 1220 GOSUB 800:B=0
  122. 1230 WHILE B<>A
  123. 1240  IF ZA=LEFT$(NAMES$(B),8) THEN 1300
  124. 1250  B=B+1
  125. 1260 WEND
  126. 1270 R1%=23:C1%=1:R2%=25:C2%=80:GOSUB 1480
  127. 1280 LOCATE 23,10:PRINT"No Such File Name. ";:FOR A=1 TO 2000:NEXT
  128. 1290 GOTO 1360
  129. 1300 KILL XT$+NAMES$(B)+".PIC"
  130. 1310 NAMES$(B)=""
  131. 1320 CLOSE:OPEN XT$+"picture.fle" FOR OUTPUT AS #1
  132. 1330 B=0
  133. 1340 WHILE B<>A:IF NAMES$(B)<>"" THEN WRITE#1,NAMES$(B)
  134. 1350 B=B+1:WEND
  135. 1360 IF FLAG THEN GOSUB 300 ELSE GOSUB 280
  136. 1370 GOSUB 1060:FOR A=1 TO 9:KEY(A) ON:NEXT:RETURN
  137. 1380 FOR A=1 TO 10:KEY(A) OFF:NEXT
  138. 1390 XLIN=CSRLIN:XPOS=POS(0):LOCATE 25,1:PRINT SPC(79);
  139. 1400 LOCATE 25,21:PRINT"Do You Wish To Leave This Program? <Y/N>";
  140. 1410 Z=INKEY$:IF Z="" THEN 1410
  141. 1420 IF Z="y" OR Z="Y" THEN 1470
  142. 1430 IF Z<>"n" AND Z<>"N" THEN 1410
  143. 1440 IF FLAG THEN GOSUB 300 ELSE GOSUB 280
  144. 1450 FOR A=1 TO 10:KEY(A) ON:NEXT:RETURN
  145. 1460 FOR A=1 TO 9:KEY(A) OFF:NEXT:Z=CHR$(0)+CHR$(119):RETURN 150
  146. 1470 RUN"menu2"
  147. 1480 DEF SEG:SUBRT%=VARPTR(A%(0)):CALL SUBRT%(R1%,C1%,R2%,C2%):RETURN
  148. 1490 DEF SEG:CLRBUF%=VARPTR(B%(0)):CALL CLRBUF%(FX%,C%(0),VIDEO%):RETURN
  149. 1500 FOR A=1 TO 9:KEY(A) OFF:NEXT:DEF SEG=VIDEO%:BSAVE XT$+"tempory.tmp",480,3040
  150. 1510 GOSUB 1520:GOSUB 310:GOSUB 280:DEF SEG=VIDEO%:BLOAD XT$+"tempory.tmp",480:LOCATE X,Y,1:RETURN
  151. 1520 KEY(10) OFF:COLOR 7,0:CLS:ON ERROR GOTO 1530:CLOSE#3:OPEN"fw.bat" FOR INPUT AS #3:CLOSE#3:HK$="YES":GOTO 1540
  152. 1530 CLOSE#3:HK$="":RESUME 1540
  153. 1540 CLS:COLOR 15:LOCATE 2,32:PRINT"SELECT DATA DRIVE":COLOR 12:LOCATE 4,28:PRINT"Current Data Drive Is "XT$:LOCATE 6,21:PRINT"You Draw It Is Configured For ";:IF HK$="YES" THEN PRINT"Hard Disk" ELSE PRINT"Floppy Disk"
  154. 1550 COLOR 2:LOCATE 8,28:PRINT"These Are Your Options:":LOCATE 10,27:COLOR 0,7:PRINT" A ":LOCATE 12,27:PRINT" B ":LOCATE 14,27:PRINT" C ":LOCATE 16,27:PRINT" D ":LOCATE 18,27:PRINT" E ":LOCATE 20,27:PRINT"F10"
  155. 1560 LOCATE 10,33:COLOR 6,0:PRINT"Set Data Drive To A:":LOCATE 12,33:PRINT"Set Data Drive To B:":LOCATE 14,33:PRINT"Set Data Drive To C:":LOCATE 16,33:PRINT"Set Data Drive To D:":LOCATE 18,33:PRINT"Set For ";
  156. 1570 IF HK$<>"YES" THEN PRINT"Hard Disk" ELSE PRINT"Floppy Disk
  157. 1580 LOCATE 20,33:PRINT"Leave This Program":COLOR 15:LOCATE 23,26:PRINT"Strike Space Bar To Continue"
  158. 1590 GOSUB 1650:IF LEN(Z)>1 AND RIGHT$(Z,1)="D" THEN 1690 ELSE IF Z=" " THEN ELSE IF Z<"A" OR Z>"E" THEN 1590
  159. 1600 IF Z="E" THEN IF HK$="YES" THEN HK$="" ELSE HK$="YES" ELSE IF Z=" " THEN ON ERROR GOTO 1680 ELSE XT$=Z+":":ON ERROR GOTO 1530
  160. 1610 IF HK$="" THEN CLOSE#3:OPEN XT$+"LOGO.COM" FOR INPUT AS #3:CLOSE#3:GOSUB 1620:GOTO 1540 ELSE IF Z=" " THEN 1670 ELSE 1540
  161. 1620 LOCATE 22,20:COLOR 31:PRINT"You may not use this diskette for data storage!"
  162. 1630 LOCATE 23,25:COLOR 7:PRINT"Insert a data diskette in drive "XT$
  163. 1640 FOR BC=1 TO 2800:NEXT:RETURN
  164. 1650 DEF SEG=&H40:POKE &H1A,PEEK(&H1C)
  165. 1660 Z=INKEY$:IF Z="" THEN 1660 ELSE IF Z<"a" OR Z>"z" THEN RETURN ELSE Z=CHR$(ASC(Z)-32):RETURN
  166. 1670 CLOSE:OPEN XT$+"PICTURE.FLE" FOR APPEND AS #1:CLOSE:KEY(10) ON:ON ERROR GOTO 490:RETURN
  167. 1680 IF ERR=61 OR ERR=67 THEN LOCATE 23,1:PRINT SPC(79);:COLOR 31:LOCATE 23,32:PRINT"Diskette is full":COLOR 7:RESUME 1700
  168. 1681 LOCATE 23,1:PRINT SPC(79);:LOCATE 24,1:PRINT SPC(79);
  169. 1689 RESUME 1670
  170. 1690 ON ERROR GOTO 490:GOTO 1470
  171. 1700 FOR BC=1 TO 2800:NEXT:GOTO 1520
  172.