home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library4 / spectern.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-11  |  10.7 KB  |  295 lines
  1. 'Program Name    : Spectern.bas  Example of Specter Factory Terminal
  2. 'Author          : Lloyd L. Smith for Spectra Technical Support
  3. 'Date            : 11-12-90
  4. 'Compuserve #    : GO PCVENB, Vendor #12/Spectra,  Tech Support ID 71530,2640
  5. 'Tech Support BBS: 813-625-1721, PC-Board, 8,N,1 USR HST 300 - 14.4, 24hrs
  6. 'Tech Support Fax: 813-625-1698  G2 & G3 compatible
  7. 'Tech Support Voc: 813-625-1172  Voice
  8. 'Concept Date    : 07-07-88
  9. 'Concept by      : SmithTronix Corporation
  10. '                : Advanced programming examples, few comments
  11. '                : Enter a six digit number to activate displays,
  12. '                : to exit Program, type stop.
  13.  
  14. DECLARE SUB Font ()
  15. DECLARE SUB messages ()
  16.  
  17. SHARED d1$, d2$, d3$, d4$, d5$, d6$, d7$, d8$, d9$, d0$, SP$
  18. SHARED P1$, P2$, P3$, P4$, P5$
  19. SHARED FA$, FB$, Fc$, Fd$, Fe$, Ff$, Fg$, fh$, fi$, FJ$, Fk$, Fl$, Fm$
  20. SHARED QN$, Fo$, FP$, FQ$, FR$, FS$, Ft$, Fu$, Fv$, Fw$, Fx$, Fy$, FZ$
  21. SHARED msg$(), size, Letcolor
  22.  
  23. DIM msg$(30)
  24.  
  25. SCREEN 9
  26.  
  27.  
  28.  
  29. CALL messages
  30.  
  31. 'blue border around entire screen
  32.  
  33. LINE (0, 0)-(639, 199), 7, BF
  34. FOR I = 0 TO 4
  35. LINE (I, 0)-(635 + I, 199), 11, B '9, B
  36. NEXT I
  37.  
  38. 'blue box around keypad
  39. FOR I = 0 TO 4
  40. LINE (25 + I, 35)-(345 + I, 185), 11, B'9, B
  41. 'LINE (25 + I, 35)-(350 + I, 185), 9, B
  42. NEXT I
  43.  
  44. G = 15
  45. FOR I = 0 TO 4
  46. LINE (30 + I + G, 40)-(70 + I + G, 60), 11, B '9, B
  47. LINE (31 + I + G, 41)-(69 + I + G, 59), 0, BF '9, B
  48. G = G + 60
  49. NEXT I
  50.  
  51. G = 15
  52. FOR I = 0 TO 4
  53. LINE (30 + I + G, 70)-(70 + I + G, 90), 11, B'9, B
  54. LINE (31 + I + G, 71)-(69 + I + G, 89), 0, BF'9, B
  55. G = G + 60
  56. NEXT I
  57.  
  58. G = 15
  59. FOR I = 0 TO 4
  60. LINE (30 + I + G, 100)-(70 + I + G, 120), 11, B'9, B
  61. LINE (31 + I + G, 101)-(69 + I + G, 119), 0, BF'9, B
  62. G = G + 60
  63. NEXT I
  64.  
  65. G = 15
  66. FOR I = 0 TO 4
  67. LINE (30 + I + G, 130)-(70 + I + G, 150), 11, B '9, B
  68. LINE (31 + I + G, 131)-(69 + I + G, 149), 0, BF '9, B
  69. G = G + 60
  70. NEXT I
  71.  
  72.  
  73. COLOR 14, 0
  74. LOCATE 2, 20
  75. PRINT "Specter"
  76. COLOR 15, 0
  77.  
  78.       CALL Font
  79.       CALL messages
  80.       GOSUB check
  81. PSET (450, 8), 0: DRAW msg$(1)
  82. PSET (550, 8), 0: DRAW msg$(2)
  83. PSET (500, 52), 0: DRAW msg$(3)
  84.  
  85.  
  86. PSET (355, 70), 7: DRAW msg$(4)
  87. PSET (355, 80), 7: DRAW msg$(5)
  88. PSET (355, 90), 7: DRAW msg$(6)
  89. PSET (500, 60), 7: DRAW msg$(7)
  90. PSET (500, 105), 0: DRAW msg$(8)
  91.  
  92. PSET (500, 152), 0: DRAW msg$(9)
  93. PSET (355, 176), 0: DRAW msg$(10)
  94.  
  95. PSET (55, 50), 0: DRAW msg$(11) 'tl
  96.  
  97. 'Numbers on the keypad
  98. PSET (125, 50), 0: DRAW d1$ '#1
  99. PSET (185, 50), 0: DRAW d2$ '#2
  100. PSET (245, 50), 0: DRAW d3$ '#3
  101. PSET (291, 50), 0: DRAW msg$(13) 'scale
  102. PSET (291, 58), 0: DRAW msg$(14) 'raw
  103.  
  104. PSET (47, 80), 0: DRAW msg$(15)
  105. PSET (125, 80), 0: DRAW d4$ '#4
  106. PSET (185, 80), 0: DRAW d5$ '#5
  107. PSET (245, 80), 0: DRAW d6$ '#6
  108. PSET (291, 78), 0: DRAW msg$(16) 'force
  109. PSET (291, 88), 0: DRAW msg$(17) 'next
  110.  
  111. PSET (47, 110), 0: DRAW msg$(18) 'clear
  112. PSET (125, 110), 0: DRAW d7$ '#7
  113. PSET (185, 110), 0: DRAW d8$ '#8
  114. PSET (245, 110), 0: DRAW d9$ '#9
  115. PSET (291, 108), 0: DRAW msg$(19) 'unforce
  116. PSET (291, 118), 0: DRAW msg$(20) 'prev
  117.  
  118.  
  119. PSET (230, 138), 0: DRAW msg$(23) 'ack
  120. PSET (230, 148), 0: DRAW msg$(24)'test
  121. PSET (185, 140), 0: DRAW d0$ '#0
  122. PSET (291, 138), 0: DRAW msg$(25) 'shift
  123.  
  124. ' Pattern used for seven segment display
  125. '    2
  126. '    --
  127. '  1| 4|3
  128. '    --
  129. '  5| 7|6
  130. '    --
  131.  
  132. idle:
  133. x = 434: y = 16
  134. Fg = 12: bg = 0
  135. again:
  136. LOCATE 16, 2: PRINT "                "
  137. LOCATE 16, 2: INPUT kb$
  138. IF UCASE$(kb$) = "STOP" THEN CLS : SYSTEM
  139. IF LEN(kb$) > 6 OR LEN(kb$) < 6 THEN GOTO again
  140.  
  141. for z=1 to 5
  142. FOR I = 1 TO LEN(kb$)
  143. A = VAL(MID$(kb$, I, 1))
  144. '                     1234567
  145. IF A = 1 THEN pat$ = "0010010"
  146. IF A = 2 THEN pat$ = "0111101"
  147. IF A = 3 THEN pat$ = "0111011"
  148. IF A = 4 THEN pat$ = "1011010"
  149. IF A = 5 THEN pat$ = "1101011"
  150. IF A = 6 THEN pat$ = "1001111"
  151. IF A = 7 THEN pat$ = "0110010"
  152. IF A = 8 THEN pat$ = "1111111"
  153. IF A = 9 THEN pat$ = "1111011"
  154. IF A = 0 THEN pat$ = "1110111"
  155.  
  156.  
  157. 'left side of seven segment
  158. IF MID$(pat$, 1, 1) = "1" THEN LINE (x, y)-(x + 1, y + 10), Fg, BF ELSE LINE (x, y)-(x + 1, y + 10), bg, BF
  159. IF MID$(pat$, 5, 1) = "1" THEN LINE (x, y + 12)-(x + 1, y + 22), Fg, BF ELSE LINE (x, y + 12)-(x + 1, y + 22), bg, BF
  160. 'top line of seven segment display
  161. IF MID$(pat$, 2, 1) = "1" THEN LINE (x + 3, y)-(x + 19, y), Fg ELSE LINE (x + 3, y)-(x + 19, y), bg
  162.  
  163. 'middle line of seven segment display
  164. IF MID$(pat$, 4, 1) = "1" THEN LINE (x + 3, y + 11)-(x + 19, y + 11), Fg ELSE LINE (x + 3, y + 11)-(x + 19, y + 11), bg
  165. 'bottom line of seven segement display
  166. IF MID$(pat$, 7, 1) = "1" THEN LINE (x + 3, y + 22)-(x + 19, y + 22), Fg ELSE LINE (x + 3, y + 22)-(x + 19, y + 22), bg
  167. 'right side of seven segment
  168. IF MID$(pat$, 3, 1) = "1" THEN LINE (x + 21, y)-(x + 22, y + 10), Fg, BF ELSE LINE (x + 21, y)-(x + 22, y + 10), bg, BF
  169. IF MID$(pat$, 6, 1) = "1" THEN LINE (x + 21, y + 12)-(x + 22, y + 22), Fg, BF ELSE LINE (x + 21, y + 12)-(x + 22, y + 22), bg, BF
  170.  
  171.  x = x + 30
  172.  NEXT I
  173. if z=1 then x=434
  174. if z=2 then x=434:y=y+53
  175. if z=3 then x=434:y=y+47
  176. if z=4 then x=434:y=y+50
  177. next z
  178. GOTO idle
  179.  
  180. check:
  181. FOR I = 1 TO 4
  182. IF I = 1 THEN W = 420: V = 10: H = 31
  183.  
  184. IF I = 2 THEN W = 420: V = 63: H = 31
  185. IF I = 3 THEN W = 420: V = 110: H = 31
  186. IF I = 4 THEN W = 420: V = 160: H = 31
  187.  
  188. LINE (W, V)-(W + 200, V), 8
  189. LINE (W + 1, V + 1)-(W + 200, V + 1), 8
  190. LINE (W + 2, V + 2)-(W + 200, V + 2), 8
  191. LINE (W + 3, V + 3)-(W + 200, V + 3), 8
  192.  
  193.  
  194. LINE (W, V + 1)-(W, V + H), 15
  195. LINE (W + 1, V + 2)-(W + 1, V + H), 15
  196. LINE (W + 2, V + 3)-(W + 2, V + H), 15
  197. LINE (W + 3, V + 4)-(W + 3, V + H), 15
  198. LINE (W + 4, V + 5)-(W + 4, V + H), 15
  199.  
  200. LINE (W, V + H)-(W + 197, V + H), 15
  201. LINE (W, V + H + 1)-(W + 198, V + H + 1), 15
  202. LINE (W, V + H + 2)-(W + 199, V + H + 2), 15
  203. LINE (W, V + H + 3)-(W + 200, V + H + 3), 15
  204.  
  205. LINE (W + 196, V)-(W + 196, V + H - 1), 8
  206. LINE (W + 197, V)-(W + 197, V + H), 8
  207. LINE (W + 198, V)-(W + 198, V + H + 1), 8
  208. LINE (W + 199, V)-(W + 199, V + H + 2), 8
  209. LINE (W + 200, V)-(W + 200, V + H + 3), 8
  210. LINE (W + 201, V)-(W + 201, V + H + 3), 8
  211.  
  212. 'make the hole
  213. LINE (W + 5, V + 4)-(W + 195, V + H - 1), 0, BF
  214.  
  215. NEXT I
  216.  
  217. RETURN
  218.  
  219. SUB Font STATIC
  220. 'Draw Font Character Set - Hand edited
  221. size = 4: Letcolor = 14
  222.     FA$ = "S=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br1u4e2f2d2l4r4d2br2"
  223.     FB$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br1u6r3f1d1G1l2br2F1d1g1l3br6"
  224.     Fc$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br5BU5H1L2G1D4F1R2E1BF1BR1"
  225.     Fd$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6R3F1D4G1L3BR6"
  226.     Fe$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6R4BD3BL2L2D3R4BR2"
  227.     Ff$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6R4BD3BL2L2BD3BR6"
  228.     Fg$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br5BU5H1L2G1D4F1R2E1U1L1BD2BR3"
  229.     fh$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6BD3R4BU3D6BR2"
  230.     fi$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1R1U6L1R2L1D6R1BR2"
  231.     FJ$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR5BU6D5G1L2H1BD1BR6"
  232.     Fk$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6BR4G3F3BR2"
  233.     Fl$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6BD6R4BR2"
  234.     Fm$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6F3E3D6BR2"
  235.     QN$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6F6U6BD6BR2"
  236.     Fo$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br5BU5H1L2G1D4F1R2E1U4BD5BR2"
  237.     FP$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6R4F1D1G1L2BD3BR5"
  238.     FQ$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br5BU5H1L2G1D4F1R2E1U4BD4H1F2BR2"
  239.     FR$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1U6R3F1D1G1L2F3BR2"
  240.     FS$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR5BU5H1L2G1D1F1R2F1D1G1L2H1BD1BR6"
  241.     Ft$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU6R4L2D6BR4"
  242.     Fu$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU6D5F1R2E1U5BD6BR2"
  243.     Fv$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU6D4F2E2U4BD6BR2"
  244.     Fw$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU6D6E2F2U6BD6BR2"
  245.     Fx$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1E6BL6F6BR2"
  246.     Fy$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU6F2E2BG2D4BR4"
  247.     FZ$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU6R6G6R6BR2"
  248.     d1$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU5E1D6L1R2BR2"
  249.     d2$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU5E1R2F1D1G4R4BR2"
  250.     d3$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU6R4G2F2D1G1L2H1BD1BR6"
  251.     d4$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR4U6G3R4BD3BR2"
  252.     d5$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU1F1R2E1U1H1L3U3R4BD6BR2"
  253.     d6$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR3BU6L1G1D4F1R2E1U1H1L2G1BD2BR6"
  254.     d7$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU6R4G3D3BR4"
  255.     d8$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR1BU1U1E1R2E1U1H1L2G1D1F1R2F1D1G1L2H1BD1BR6"
  256.     d9$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "BR5BU4G1L2H1U1E1R2F1D4G1L1BR4"
  257.     d0$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br5BU5H1L2G1D4F1R2E1U4BD5BR2"
  258.     SP$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br7"
  259.     P1$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br2L1U1R1D1BR2"
  260.     P2$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br2L1U1R1D2G1BE1BU1BR2"
  261.     P3$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br2L1U1R1D1BU4L1U1R1D1BD4BR2"
  262.     P4$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br2L1U1R1D2G1BE1BU5L1U1R1D1BD4BR2"
  263.     P5$ = "s=" + VARPTR$(size) + "c=" + VARPTR$(Letcolor) + "br1BU5E1R2F1D1H1L1D1BD2R1BR3"
  264. END SUB
  265.  
  266. SUB messages STATIC
  267. 'Text Messages using Draw Chatacter Fonts
  268. msg$(1) = Fm$ + Fw$ + SP$ + Ft$ + Fy$ + FP$ + Fe$
  269. msg$(2) = FA$ + Fd$ + Fd$ + FR$ + Fe$ + FS$ + FS$
  270. msg$(3) = Fl$ + Fo$ + Fc$ + FA$ + Ft$ + fi$ + Fo$ + QN$
  271. msg$(4) = FA$ + Fl$ + FA$ + FR$ + Fm$
  272. msg$(5) = Ff$ + Fo$ + FR$ + Fc$ + Fe$ + Fd$
  273. msg$(6) = FP$ + FR$ + Fo$ + Ft$ + Fe$ + Fc$ + Ft$ + Fe$ + Fd$
  274. msg$(7) = FP$ + P1$ + Fu$ + P1$ + SP$ + FP$ + Fc$ + SP$ + QN$ + Fo$
  275. msg$(8) = Ft$ + FA$ + Fg$ + SP$ + Fd$ + SP$ + Ft$ + Fy$ + FP$ + Fe$
  276. msg$(9) = FP$ + FR$ + Fe$ + FS$ + Fe$ + Ft$
  277. msg$(10) = Fc$ + Fu$ + FR$ + FR$ + Fe$ + QN$ + Ft$
  278. msg$(11) = Ft$ + P1$ + Fl$
  279. msg$(12) = FR$ + FA$ + FP$
  280. msg$(13) = FS$ + Fc$ + FA$ + Fl$ + Fe$
  281. msg$(14) = FR$ + FA$ + Fw$
  282. msg$(15) = Fe$ + QN$ + Ft$ + Fe$ + FR$
  283. msg$(16) = Ff$ + Fo$ + FR$ + Fc$ + Fe$
  284. msg$(17) = QN$ + Fe$ + Fx$ + Ft$
  285. msg$(18) = Fc$ + Fl$ + Fe$ + FA$ + FR$
  286. msg$(19) = Fu$ + QN$ + Ff$ + FR$ + Fc$
  287. msg$(20) = FP$ + FR$ + Fe$ + Fv$
  288. msg$(21) = Fc$ + fh$ + FA$ + QN$ + Fg$ + Fe$
  289. msg$(22) = FR$ + Fu$ + QN$
  290. msg$(23) = FA$ + Fc$ + Fk$
  291. msg$(24) = Ft$ + Fe$ + FS$ + Ft$
  292. msg$(25) = FS$ + fh$ + fi$ + Ff$ + Ft$
  293. END SUB
  294.  
  295.