home *** CD-ROM | disk | FTP | other *** search
/ RUN Flagazine Extra: Supplement 2: Soundwriter / run-supplement-2.zip / KADERS.BAS < prev    next >
BASIC Source File  |  1991-09-05  |  8KB  |  145 lines
  1. 1000 REM KADERS -----  GWBASIC (C) KOOS VAN EGMOND
  2. 1010 COMMON MENUFL%:DIM KV(31),KA(31)
  3. 1020 DEF SEG=0:MON%=(PEEK(&H410) AND 48)/16:DEF SEG
  4. 1030 FOR I=0 TO 31:KV(I)=I:KA(I)=I:NEXT I
  5. 1040 IF MON%=3 THEN FOR I=0 TO 31:KV(I)=3:KA(I)=0:NEXT I
  6. 1050 CLS:KEY OFF:SCREEN 0:RANDOMIZE TIMER:DIM T(6,40),K(6,40)
  7. 1060 KD$="01,79,01,25,07,01":GOSUB 10000
  8. 1070 K=1:KD$="S"
  9. 1080 KX1=INT(RND*70)+2:KX2=INT(RND*(75-KX1)+KX1+3)
  10. 1090 KY1=INT(RND*18)+2 :KY2=INT(RND*(21-KY1)+KY1+3)
  11. 1100 CA=INT(RND*7)+1:CV=INT(RND*8)+8:IF CA=CV THEN 1100
  12. 1110 GOSUB 10040
  13. 1120 IF K<30 THEN K=K+1:GOTO 1080
  14. 1130 KD$="04,25,04,08,23,04,S":GOSUB 10000
  15. 1140 COLOR KV(10),KA(4):LOCATE 6,8:PRINT "Druk een toets":WHILE INKEY$="":WEND
  16. 1150 KD$="01,79,01,05,12,00":GOSUB 10000
  17. 1160 KD$="01,79,06,25,07,01":GOSUB 10000
  18. 1170 T$="Dit programma bevat een subroutine die op eenvoudige wijze kaders plaatst."
  19. 1180 COLOR KV(10),KA(0):FOR T=1 TO 74:LOCATE 3,4:PRINT LEFT$(T$,T):NEXT T
  20. 1190 KD$="05,35,10,20,14,06":GOSUB 10000:COLOR KV(15),KA(6):LOCATE 13,9:PRINT "Kader zonder schaduw"
  21. 1200 KD$="45,70,15,22,11,02,S":GOSUB 10000:COLOR KV(14),KA(2):LOCATE 20,49:PRINT "Kader met schaduw"
  22. 1210 T=VAL(RIGHT$(TIME$,2))+3:WHILE VAL(RIGHT$(TIME$,2))<>T MOD 60:WEND
  23. 1220 KD$="32,62,08,18,13,04,S":GOSUB 10000
  24. 1230 COLOR KV(7),KA(4):LOCATE 10,35:PRINT "1 --> Uitleg over routine"
  25. 1240 LOCATE 12,35:PRINT "2 --> Layout samenstellen"
  26. 1250 LOCATE 14,35:PRINT "3 --> Random kaders
  27. 1260 LOCATE 16,35:PRINT "<Esc> Stoppen"
  28. 1270 I$=INKEY$:IF I$="" THEN 1260
  29. 1280 IF I$=CHR$(27) THEN 1330
  30. 1290 IF I$="1" THEN 1360
  31. 1300 IF I$="2" THEN 1760
  32. 1310 IF I$="3" THEN 1060
  33. 1320 GOTO 1260
  34. 1330 COLOR KV(7),KA(0)
  35. 1340 CLS:SCREEN 0:IF MENUFL% THEN 120
  36. 1350 END
  37. 1360 REM **************** UITLEG OVER ROUTINE
  38. 1370 KD$="03,54,07,20,04,07,S":GOSUB 10000:COLOR KV(1),KA(7)
  39. 1380 LOCATE 8,5:PRINT "De subroutine die deze kaders maakt staat in de"
  40. 1390 LOCATE 9,5:PRINT "regels 10000 t/m 10200."
  41. 1400 LOCATE 11,5:PRINT "De routine zet een string van getallen om in een"
  42. 1410 LOCATE 12,5:PRINT "coördinatenstelsel dat de plaats en de grote van"
  43. 1420 LOCATE 13,5:PRINT "van het kader bepaalt."
  44. 1430 LOCATE 14,5:PRINT "Het getallen-string bevat ook de kleurinformatie."
  45. 1440 LOCATE 15,5:PRINT "Aan het eind van de string kan ook de letter S
  46. 1450 LOCATE 16,5:PRINT "toegevoegd worden die aangeeft dat het kader met"
  47. 1460 LOCATE 17,5:PRINT "een schaduw geplaatst moet worden."
  48. 1470 LOCATE 19,5:PRINT "Voorbeeld van een string: "CHR$(34)"05,25,10,20,14,04,S"CHR$(34)
  49. 1480 T=VAL(RIGHT$(TIME$,2))+3:WHILE VAL(RIGHT$(TIME$,2))<>T MOD 60:WEND
  50. 1490 KD$="58,75,10,14,15,03,S":GOSUB 10000
  51. 1500 COLOR KV(4),KA(3):LOCATE 12,60:PRINT "Druk een toets":WHILE INKEY$="":WEND
  52. 1510 KD$="08,71,09,23,14,06,S":GOSUB 10000:COLOR KV(15),KA(6)
  53. 1520 LOCATE 10,10:PRINT "Om deze routine te gebruiken moet de string in een variabele"
  54. 1530 LOCATE 11,10:PRINT "geplaatst worden. In dit programma is dat KD$."
  55. 1540 LOCATE 12,10:PRINT "Voor dit kader werd de volgende regel gebruikt:"
  56. 1550 LOCATE 14,22:PRINT "KD$="CHR$(34)"08,71,09,23,14,06,S"CHR$(34)":GOSUB 10000"
  57. 1560 LOCATE 16,10:PRINT "Getal (08) geeft de linkerkolompositie van het kader aan."
  58. 1570 LOCATE 17,10:PRINT "Getal (71) geeft de rechterkolompositie van het kader aan."
  59. 1580 LOCATE 18,10:PRINT "Getal (09) geeft de regelpositie van bovenzijde kader aan."
  60. 1590 LOCATE 19,10:PRINT "Getal (23) geeft de regelpositie van onderzijde kader aan."
  61. 1600 LOCATE 20,10:PRINT "Getal (14) geeft de voorgrondkleur aan.      (geel)"
  62. 1610 LOCATE 21,10:PRINT "Getal (06) geeft de achtergrondkleur aan.    (bruin)"
  63. 1620 LOCATE 22,10:PRINT "De (S) maakt een schaduw, voor geen schaduw de S weg laten."
  64. 1630 T=VAL(RIGHT$(TIME$,2))+3:WHILE VAL(RIGHT$(TIME$,2))<>T MOD 60:WEND:KD$="59,76,11,13,09,05,S":GOSUB 10000
  65. 1640 COLOR KV(11),KA(5):LOCATE 12,61:PRINT "Druk een toets":WHILE INKEY$="":WEND
  66. 1650 KD$="05,75,12,22,06,02,S":GOSUB 10000:COLOR KV(14),KA(2)
  67. 1660 LOCATE 13,7:PRINT "Voorwaarde:
  68. 1670 LOCATE 15,7:PRINT "Rechterkolompositie moet groter zijn dan de linkerkolompositie en"
  69. 1680 LOCATE 16,7:PRINT "kleiner dan het aantal schermkolommen.  (40 of 80)"
  70. 1690 LOCATE 18,7:PRINT "Regelpositie van de onderzijde moet groter zijn dan de regelpositie"
  71. 1700 LOCATE 19,7:PRINT "van de bovenzijde en kleiner dan het aantal schermregels.  (25)"
  72. 1710 LOCATE 21,7:PRINT "houdt rekening met gebruik van schaduw wat betreft aantal posities."
  73. 1720 T=VAL(RIGHT$(TIME$,2))+3:WHILE VAL(RIGHT$(TIME$,2))<>T MOD 60:WEND
  74. 1730 KD$="25,42,10,12,14,01,S":GOSUB 10000
  75. 1740 COLOR KV(15),KA(1):LOCATE 11,27:PRINT "Druk een toets":WHILE INKEY$="":WEND
  76. 1750 GOTO 1220
  77. 1760 REM **************** SAMENSTELLEN LAYOUT
  78. 1770 COLOR KV(7),KA(0):CLS
  79. 1780 FOR Y=0 TO 6:FOR X=0 TO 40:T(Y,X)=0:K(Y,X)=0:NEXT X,Y
  80. 1790 KD$="20,60,08,14,03,00":GOSUB 10000
  81. 1800 COLOR KV(4),KA(0):LOCATE 10,22:PRINT "KD$="CHR$(34)"  ,  ,  ,  ,  ,  , "CHR$(34)":GOSUB 10000"
  82. 1810 COLOR KV(3),KA(0):LOCATE 13,22:PRINT "Q = Stoppen"
  83. 1820 COLOR KV(2),KA(0):LOCATE 12,22:PRINT "Geef linkerkolompositie   (2 cijfers)":P=1:GOSUB 2140:G1$=G$
  84. 1830 IF I$="Q" OR I$="q" THEN 1220
  85. 1840 LOCATE 13,22:PRINT "           ":LOCATE 12,22
  86. 1850 PRINT "Geef rechterkolompositie":P=4:GOSUB 2140:G2$=G$
  87. 1860 PRINT "Geef bovenregelpositie   ":P=7:GOSUB 2140:G3$=G$
  88. 1870 PRINT "Geef onderregelpositie":P=10:GOSUB 2140:G4$=G$
  89. 1880 PRINT "Geef voorgrondkleur   ":P=13:GOSUB 2140:G5$=G$
  90. 1890 PRINT "Geef achtergrondkleur":P=16:GOSUB 2140:G6$=G$
  91. 1900 PRINT "Wil je schaduw [j/n]                 ":COLOR ,KA(1):LOCATE 10,45:PRINT " "
  92. 1910 I$=INKEY$
  93. 1920 IF I$="J" OR I$="j" THEN I$="S":S=1:GOTO 1950
  94. 1930 IF I$="N" OR I$="n" THEN I$=" ":S=0:GOTO 1950
  95. 1940 GOTO 1910
  96. 1950 COLOR KV(4),KA(0):LOCATE 10,45:PRINT I$:LOCATE 12,22:PRINT STRING$(20,32)
  97. 1960 IF VAL(G1$)<1 OR VAL(G1$)=>80-2*S THEN 2110
  98. 1970 IF VAL(G2$)=<VAL(G1$) OR VAL(G2$)>80-2*S THEN 2110
  99. 1980 IF VAL(G3$)<1 OR VAL(G3$)=>25-S THEN 2110
  100. 1990 IF VAL(G4$)=<VAL(G3$) OR VAL(G4$)>25-S THEN 2110
  101. 2000 COLOR KV(14),KA(0):LOCATE 12,22:PRINT "Druk na plaatsing op een toets"
  102. 2010 LOCATE 13,22:PRINT "voor dit menu"
  103. 2020 T=VAL(RIGHT$(TIME$,2))+3:WHILE VAL(RIGHT$(TIME$,2))<>T MOD 60:WEND
  104. 2030 FOR Y=0 TO 6:FOR X=0 TO 40
  105. 2040 VG=K(Y,X) MOD 16:BG=((K(Y,X)-VG)/16) MOD 128
  106. 2050 COLOR KV(VG),KA(BG):LOCATE Y+8,X+20:PRINT CHR$(T(Y,X)):NEXT X,Y
  107. 2060 KD$=G1$+","+G2$+","+G3$+","+G4$+","+G5$+","+G6$+","+I$:GOSUB 10000
  108. 2070 FOR Y=0 TO 6:FOR X=0 TO 40
  109. 2080 T(Y,X)=SCREEN(Y+8,X+20):K(Y,X)=SCREEN(Y+8,X+20,1):NEXT X,Y
  110. 2090 WHILE INKEY$<>"":WEND:WHILE INKEY$="":WEND
  111. 2100 GOTO 1790
  112. 2110 COLOR KV(14),KA(0):LOCATE 12,22:PRINT "Kader kan niet geplaatst worden"
  113. 2120 T=VAL(RIGHT$(TIME$,2))+3:WHILE VAL(RIGHT$(TIME$,2))<>T MOD 60:WEND
  114. 2130 GOTO 1790
  115. 2140 COLOR KV(15),KA(1):LOCATE 10,26+P:PRINT "  ":G$=" "
  116. 2150 I$=INKEY$
  117. 2160 IF I$="Q" OR I$="q" AND P=1 THEN 2210
  118. 2170 IF I$=CHR$(13) AND LEFT$(G$,1)<>" " THEN 2200
  119. 2180 IF I$<"0" OR I$>"9" THEN 2150
  120. 2190 G$=RIGHT$(G$,1)+I$:LOCATE 10,26+P:PRINT G$:GOTO 2150
  121. 2200 COLOR KV(4),KA(0):LOCATE 10,26+P:PRINT G$:COLOR KV(2),KA(0):LOCATE 12,22
  122. 2210 RETURN
  123. 10000 REM *************** KADERROUTINE
  124. 10010 KX1=VAL(LEFT$(KD$,2)):KX2=VAL(MID$(KD$,4,2))
  125. 10020 KY1=VAL(MID$(KD$,7,2)):KY2=VAL(MID$(KD$,10,2))
  126. 10030 CV=VAL(MID$(KD$,13,2)):CA=VAL(MID$(KD$,16,2))
  127. 10040 T$=CHR$(201)+STRING$(KX2-KX1-1,205)+CHR$(187)
  128. 10050 M$=CHR$(186)+STRING$(KX2-KX1-1,32)+CHR$(186)
  129. 10060 B$=CHR$(200)+STRING$(KX2-KX1-1,205)+CHR$(188)
  130. 10070 COLOR KV(CV),KA(CA):LOCATE KY1,KX1:PRINT T$
  131. 10080 FOR N=KY1+1 TO KY2-1:COLOR KV(CV),KA(CA):LOCATE N,KX1:PRINT M$;
  132. 10090 IF RIGHT$(KD$,1)<>"S" THEN 10120
  133. 10100 IF MON%<>3  THEN COLOR 8,0:PRINT CHR$(SCREEN(N,KX2+1))CHR$(SCREEN(N,KX2+2)):GOTO 10120
  134. 10110 COLOR KV(8),KA(0):PRINT CHR$(SCREEN(N,KX2+1))CHR$(177)
  135. 10120 NEXT N
  136. 10130 COLOR KV(CV),KA(CA):LOCATE KY2,KX1:PRINT B$;:IF RIGHT$(KD$,1)<>"S" THEN 10200
  137. 10140 IF MON%<>3 THEN COLOR 8,0:PRINT CHR$(SCREEN(N,KX2+1))CHR$(SCREEN(N,KX2+2));:GOTO 10160
  138. 10150 COLOR KV(8),KA(0):PRINT CHR$(SCREEN(N,KX2+1))CHR$(177);
  139. 10160 LOCATE KY2+1,KX1+2:FOR N=KX1+2 TO KX2+2
  140. 10170 IF MON%<>3 THEN COLOR 8,0:PRINT CHR$(SCREEN(KY2+1,N));:GOTO 10190
  141. 10180 COLOR KV(8),KA(0):PRINT CHR$(177);
  142. 10190 NEXT N
  143. 10200 RETURN
  144. 20000 REM EIND KADERS
  145.