Advertisement
Guest User

Untitled

a guest
May 5th, 2015
212
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 21.09 KB | None | 0 0
  1. gosub initialise
  2. gosub mainloop
  3. exit
  4.  
  5. rem ##################################
  6. label mainloop
  7. repeat
  8.  
  9. rem Insertion Point 25
  10. gosub titlescreen
  11. gosub mainmenu
  12. until (1=2)
  13. return
  14.  
  15. rem Insertion Point 26
  16. rem #####################################################
  17. label titlescreen
  18. oldjoypad=joypad
  19. cont=0
  20. fade=0:fadedir=10
  21. rem poke "textalign","cc"
  22. for a=1 to numtgem
  23. tgemx(a)=ran(580)
  24. tgemy(a)=ran(400)-400
  25. tgemp(a)=int(ran(4))+1
  26.  
  27. tgems(a)=int(ran(5))+2
  28. next a
  29.  
  30. repeat
  31. gosub flipscreen
  32. gosub background
  33.  
  34. for a=1 to numtgem
  35. x1=tgemx(a)
  36. y1=tgemy(a)
  37. piece=tgemp(a)
  38. gosub drawpiece
  39. y1=y1+tgems(a)
  40. if y1>560 then
  41. y1=y1-600
  42. tgemx(a)=ran(580)
  43. tgemp(a)=int(ran(4))+1
  44. tgems(a)=int(ran(5))+2
  45. fi
  46. tgemy(a)=y1
  47. next a
  48.  
  49. setrgb 1,0,0,0
  50. for x=-2 to 2 step 4
  51. for y=-2 to 2 step 4
  52. text 320+x,256+y,"'Gemocide'"
  53. text 320+x,290+y,"(c) Marc Gale (Xalthorn) 2002"
  54. next y
  55. next x
  56. setrgb 1,255,255,255
  57. text 320,256,"'Gemocide'"
  58. text 320,290,"(c) Marc Gale (Xalthorn) 2002"
  59.  
  60. setrgb 1,fade,fade,fade
  61. text 320,324,"Press any button to start"
  62. joypad=peek("port1")
  63. if joypad<>oldjoypad then
  64. if joypad>0 then
  65. cont=1
  66. else
  67. oldjoypad=joypad
  68. fi
  69. fi
  70.  
  71. fade=fade+fadedir
  72. if fade>255 or fade<0 then fadedir=-fadedir fi
  73. until (cont=1)
  74. return
  75.  
  76. rem Insertion Point 22
  77. rem #####################################################
  78. label mainmenu
  79. oldjoypad=joypad
  80. cont=0
  81. option=1
  82. rem poke "textalign","cc"
  83. repeat
  84. gosub flipscreen
  85. gosub background
  86.  
  87. x1=290:y1=option*50+165
  88. piece=option
  89. gosub drawpiece
  90.  
  91. setrgb 1,0,0,0
  92. for x=-2 to 2 step 4
  93. for y=-2 to 2 step 4
  94. text 320+x,40+y,"'Gemocide'"
  95. text 320+x,70+y,"(c) Marc Gale (Xalthorn) 2002"
  96. text 320+x,200+y,"Return to Title Screen"
  97. text 320+x,250+y,"Instructions"
  98. text 320+x,300+y,"Start Game"
  99. next y
  100. next x
  101. setrgb 1,255,255,255
  102. text 320,40,"'Gemocide'"
  103. text 320,70,"(c) Marc Gale (Xalthorn) 2002"
  104. text 320,200,"Return to Title Screen"
  105. text 320,250,"Instructions"
  106. text 320,300,"Start Game"
  107.  
  108. joypad=peek("port1")
  109. if joypad<>oldjoypad then
  110. if and(joypad,16384)>0 then
  111. if option=1 then
  112. cont=1
  113. fi
  114. if option=2 then
  115. gosub instructions
  116. fi
  117. if option=3 then
  118. gosub gameloop
  119. fi
  120. rem poke "textalign","cc"
  121. oldjoypad=joypad
  122. else
  123. if and(joypad,16)>0 and option>1 then
  124. option=option-1
  125. fi
  126. if and(joypad,64)>0 and option<3 then
  127. option=option+1
  128. fi
  129. oldjoypad=joypad
  130. fi
  131. fi
  132. until (cont=1)
  133. return
  134.  
  135. rem #####################################################
  136. label instructions
  137. rem poke "textalign","lb"
  138. setdispbuf curbuf
  139. setdrawbuf curbuf
  140.  
  141. gosub background
  142.  
  143. setrgb 1,0,0,0
  144. line 50,60 to 600,60
  145.  
  146. setrgb 1,0,0,0
  147. for x=-1 to 1 step 2
  148. for y=-1 to 1 step 2
  149. text 50+x,50+y,"Gemocide - Copyright Marc Gale (Xalthorn) 2002"
  150. next y
  151. next x
  152. setrgb 1,255,255,255
  153. text 50,50,"Gemocide - Copyright Marc Gale (Xalthorn) 2002"
  154.  
  155. for a=1 to instructlines
  156. if in$(a)<>"" then
  157. for b=1 to len(in$(a))
  158. setrgb 1,100,50,0
  159. for x=-1 to 1 step 2
  160. for y=-1 to 1 step 2
  161. text b*12+50+x,a*18+70+y,mid$(in$(a),b,1)
  162. next y
  163. next x
  164. setrgb 1,200,200,0
  165. text b*12+50,a*18+70,mid$(in$(a),b,1)
  166. buttons=or(peek("port1"),peek("port2"))
  167. if buttons=0 then
  168. wait 0.1
  169. fi
  170. if buttons=4096 then
  171. a=instructlines
  172. b=len(in$(a))
  173. fi
  174. next b
  175. fi
  176. next a
  177.  
  178. setrgb 1,255,255,255
  179. text 320,490,"Press the X button for the main menu","cc"
  180.  
  181. repeat
  182. joypad=peek("port1")
  183. until (joypad=0)
  184. repeat
  185. joypad=peek("port1")
  186. until (and(joypad,16384)=16384)
  187. return
  188.  
  189. rem #####################################################
  190. label setupinstructions
  191. instructlines=22
  192. dim in$(instructlines)
  193. for a=1 to instructlines
  194. in$(a)=""
  195. next a
  196.  
  197. in$(1)="The aim of Gemocide is to place a gem into "
  198. in$(2)="each of the gem receptacles (wireframe gems)."
  199. in$(3)="The gems are selected by moving the flashing"
  200. in$(4)="cursor over the gem and pressing the X button."
  201. in$(5)="When a gem is selected, the flashing cursor "
  202. in$(6)="changes colour to match the gem. To unselect"
  203. in$(7)="a gem, press X again."
  204. in$(9)="To move a gem, select it and then press one of "
  205. in$(10)="the direction buttons. The gem will then "
  206. in$(11)="move across the board until it hits something"
  207. in$(12)="or the edge of the board."
  208. in$(14)="When a gem collides with something else, it "
  209. in$(15)="might cause an effect. All of the effects can"
  210. in$(16)="be shown whilst playing by pressing the L1 "
  211. in$(17)="button, but a quick summary follows."
  212. in$(19)="Gem hits another gem of the same colour, the "
  213. in$(20)="target gem is upgraded, and the original gem"
  214. in$(21)="is destroyed. The upgrade order is yellow to"
  215. in$(22)="green to red to blue to yellow."
  216. return
  217.  
  218.  
  219. rem #####################################################
  220. label startmenu
  221. choice=1:done=0
  222. repeat
  223. gosub flipscreen
  224. setrgb 1,0,0,255
  225. setrgb 2,100,100,255
  226. setrgb 3,100,100,255
  227. gtriangle 200,400 to 200,100 to 450,100
  228. setrgb 3,0,0,255
  229. gtriangle 200,400 to 450,100 to 450,400
  230. setrgb 1,0,0,0
  231. rectangle 200,100 to 450,400
  232.  
  233. x1=290:y1=choice*50+165
  234. piece=choice
  235. gosub drawpiece
  236.  
  237. setrgb 1,0,0,0
  238. for x=-2 to 2 step 4
  239. for y=-2 to 2 step 4
  240. text 320+x,200+y,"Return to Game"
  241. text 320+x,250+y,"Restart Level"
  242. text 320+x,300+y,"Quit Game"
  243. next y
  244. next x
  245. setrgb 1,255,255,255
  246. text 320,200,"Return to Game"
  247. text 320,250,"Restart Level"
  248. text 320,300,"Quit Game"
  249.  
  250. joypad=peek("port1")
  251. if joypad<>oldjoypad then
  252. if and(joypad,16384)>0 then
  253. if choice=1 then
  254. done=1
  255. fi
  256. if choice=2 then
  257. gosub buildlevel
  258. done=1
  259. fi
  260. if choice=3 then
  261. quit=1
  262. done=1
  263. fi
  264. oldjoypad=joypad
  265. else
  266. if and(joypad,16)>0 and choice>1 then
  267. choice=choice-1
  268. fi
  269. if and(joypad,64)>0 and choice<3 then
  270. choice=choice+1
  271. fi
  272. oldjoypad=joypad
  273. fi
  274. fi
  275. until (done=1)
  276. return
  277.  
  278. rem #####################################################
  279. label gameloop
  280. level=1
  281. quit=0
  282. repeat
  283. gosub buildlevel
  284. repeat
  285. gosub flipscreen
  286. gosub background
  287. gosub drawboard
  288.  
  289. rem poke "textalign","cc"
  290. setrgb 1,255,255,255
  291.  
  292. text 320,450,l$
  293.  
  294. cb=cb+cbd
  295. if cb<0 or cb>255 then cbd=-cbd fi
  296.  
  297. if slide=0 then
  298. gosub processinput
  299. else
  300. gosub movepiece
  301. fi
  302. if moved=0 then
  303. cdelay=cdelaybase
  304. cwait=0
  305. fi
  306. if cwait>0 then cwait=cwait-1 fi
  307. until (numout=0 or quit=1)
  308. if numout=0 then
  309. gosub background
  310. cx=0:cy=0
  311. gosub drawboard
  312. repeat
  313. joypad=peek("port1")
  314. until (joypad=0)
  315. rem poke "textalign","cc"
  316. setrgb 1,255,255,255
  317. leveldone(level)=moves
  318. g$="Well done, you completed the level in "
  319. g$=g$+str$(leveldone(level))
  320. g$=g$+" moves."
  321. text 320,475,g$
  322. text 320,500,"Press any button for the next level"
  323. setdispbuf curbuf
  324. repeat
  325. joypad=peek("port1")
  326. until (joypad>0)
  327. fi
  328. level=level+1
  329. if level>maxlevels then
  330. level=1
  331. fi
  332. until (quit=1)
  333. return
  334.  
  335.  
  336. rem ##################################
  337. label background
  338. setrgb 1,0,0,255
  339. setrgb 2,100,100,255
  340. setrgb 3,100,100,255
  341. gtriangle 0,512 to 0,0 to 640,0
  342. setrgb 3,0,0,255
  343. gtriangle 0,512 to 640,0 to 640,512
  344. return
  345.  
  346. rem Insertion Point 19
  347. rem #####################################################
  348. label buildlevel
  349. l$="Level "+str$(level)+" of "+str$(maxlevels)
  350. if leveldone(level)>0 then
  351. l$=l$+" (Completed in "+str$(leveldone(level))+" moves)"
  352. fi
  353.  
  354. moves=0
  355. numcom=levelc(level)
  356. for y=1 to 10
  357. for x=1 to 10
  358. board(x,y)=0
  359. next x
  360. next y
  361.  
  362. numout=0
  363. for a=1 to numcom
  364. x=levels(level,a,1)
  365. y=levels(level,a,2)
  366. p=levels(level,a,3)
  367. board(x,y)=p
  368. if p>100 then
  369. numout=numout+1
  370. fi
  371. next a
  372.  
  373. cx=5:cy=5
  374. return
  375. rem Insertion Point 17
  376. rem #####################################################
  377. label collision
  378. target=board(ttx,tty)
  379.  
  380. if piece=target then
  381. board(tx,ty)=0
  382. target=target+1
  383. if target=5 then target=1 fi
  384. board(ttx,tty)=target
  385. cx=ttx:cy=tty
  386. return
  387. fi
  388.  
  389. if piece=target-100 then
  390. board(tx,ty)=0
  391. board(ttx,tty)=0
  392. numout=numout-1
  393. cx=ttx:cy=tty
  394. return
  395. fi
  396.  
  397. if piece=1 and target<100 then
  398. board(tx,ty)=0
  399. target=target-1
  400. board(ttx,tty)=target
  401. cx=ttx:cy=tty
  402. return
  403. fi
  404.  
  405. if piece=2 and target<100 then
  406. board(tx,ty)=board(ttx,tty)
  407. board(ttx,tty)=piece
  408. cx=ttx:cy=tty
  409. return
  410. fi
  411.  
  412. if piece=3 and target=100 then
  413. board(tx,ty)=0
  414. board(ttx,tty)=0
  415. cx=ttx:cy=tty
  416. return
  417. fi
  418.  
  419. if piece=4 and target<100 then
  420. board(tx,ty)=target
  421. return
  422. fi
  423. return
  424.  
  425. rem #####################################################
  426. label movepiece
  427. piece=board(tx,ty)
  428. ttx=tx+txd:tty=ty+tyd
  429. if ttx<1 or ttx>10 or tty<1 or tty>10 then
  430. slide=0
  431. cx=tx:cy=ty
  432. selection=0
  433. return
  434. fi
  435.  
  436. if board(ttx,tty)>0 then
  437. slide=0
  438. cx=tx:cy=ty
  439. selection=0
  440. gosub collision
  441. return
  442. fi
  443.  
  444. board(tx,ty)=0
  445. board(ttx,tty)=piece
  446. tx=ttx:ty=tty
  447. return
  448. rem Insertion Point 16
  449. rem #####################################################
  450. label processinput
  451. joypad=peek("port1")
  452. moved=0
  453.  
  454. if and(joypad,16)>0 and cy<10 then
  455. if cwait>0 then
  456. cwait=cwait-1
  457. cdelay=cdelay-1
  458. moved=1
  459. else
  460. if selection=0 then
  461. cy=cy+1
  462. moved=1
  463. cwait=cdelay
  464. else
  465. tx=cx:ty=cy:cx=0:cy=0
  466. slide=1:moves=moves+1
  467. txd=0:tyd=1
  468. fi
  469. fi
  470. fi
  471.  
  472. if and(joypad,32)>0 and cx<10 then
  473. if cwait>0 then
  474. cwait=cwait-1
  475. cdelay=cdelay-1
  476. moved=1
  477. else
  478. if selection=0 then
  479. cx=cx+1
  480. moved=1
  481. cwait=cdelay
  482. else
  483. tx=cx:ty=cy:cx=0:cy=0
  484. slide=1:moves=moves+1
  485. txd=1:tyd=0
  486. fi
  487. fi
  488. fi
  489.  
  490. if and(joypad,64)>0 and cy>1 then
  491. if cwait>0 then
  492. cwait=cwait-1
  493. cdelay=cdelay-1
  494. moved=1
  495. else
  496. if selection=0 then
  497. cy=cy-1
  498. moved=1
  499. cwait=cdelay
  500. else
  501. tx=cx:ty=cy:cx=0:cy=0
  502. slide=1:moves=moves+1
  503. txd=0:tyd=-1
  504. fi
  505. fi
  506. fi
  507.  
  508. if and(joypad,128)>0 and cx>1 then
  509. if cwait>0 then
  510. cwait=cwait-1
  511. cdelay=cdelay-1
  512. moved=1
  513. else
  514. if selection=0 then
  515. cx=cx-1
  516. moved=1
  517. cwait=cdelay
  518. else
  519. tx=cx:ty=cy:cx=0:cy=0
  520. slide=1:moves=moves+1
  521. txd=-1:tyd=0
  522. fi
  523. fi
  524. fi
  525.  
  526. rem Insertion Point 18
  527. if and(joypad,16384)>0 then
  528. if selection>0 then
  529. selection=0
  530. else
  531. if board(cx,cy)>0 and board(cx,cy)<100 then
  532. selection=board(cx,cy)
  533. fi
  534. fi
  535. repeat
  536. joypad=peek("port1")
  537. until (and(joypad,16384)=0)
  538. fi
  539.  
  540. rem Insertion Point 20
  541. if and(joypad,1024)>0 then
  542. gosub showhelp
  543. return
  544. fi
  545. rem Insertion Point 23
  546. if and(joypad,8)>0 then
  547. gosub startmenu
  548. return
  549. fi
  550. return
  551.  
  552. rem Insertion Point 21
  553. rem #####################################################
  554. label showhelp
  555. gosub background
  556. x1=20:y1=80:piece=1:gosub drawpiece
  557. x1=90:gosub drawpiece
  558. x1=160:piece=2:gosub drawpiece
  559.  
  560. x1=20:y1=140:piece=2:gosub drawpiece
  561. x1=90:gosub drawpiece
  562. x1=160:piece=3:gosub drawpiece
  563.  
  564. x1=20:y1=200:piece=3:gosub drawpiece
  565. x1=90:gosub drawpiece
  566. x1=160:piece=4:gosub drawpiece
  567.  
  568. x1=20:y1=260:piece=4:gosub drawpiece
  569. x1=90:gosub drawpiece
  570. x1=160:piece=1:gosub drawpiece
  571.  
  572. x1=20:y1=320:piece=1:gosub drawpiece
  573. x1=90:piece=2:gosub drawpiece
  574. x1=160:piece=1:gosub drawpiece
  575.  
  576. x1=20:y1=380:piece=1:gosub drawpiece
  577. x1=90:piece=3:gosub drawpiece
  578. x1=160:piece=2:gosub drawpiece
  579.  
  580. x1=20:y1=440:piece=1:gosub drawpiece
  581. x1=90:piece=4:gosub drawpiece
  582. x1=160:piece=3:gosub drawpiece
  583.  
  584. x1=320:y1=80:piece=4:gosub drawpiece
  585. x1=390:piece=1:gosub drawpiece
  586. x1=460:gosub drawpiece
  587. x1=510:gosub drawpiece
  588.  
  589. x1=320:y1=140:piece=4:gosub drawpiece
  590. x1=390:piece=2:gosub drawpiece
  591. x1=460:gosub drawpiece
  592. x1=510:gosub drawpiece
  593.  
  594. x1=320:y1=200:piece=4:gosub drawpiece
  595. x1=390:piece=3:gosub drawpiece
  596. x1=460:gosub drawpiece
  597. x1=510:gosub drawpiece
  598.  
  599. x1=320:y1=260:piece=2:gosub drawpiece
  600. x1=390:piece=1:gosub drawpiece
  601. x1=460:gosub drawpiece
  602. x1=510:piece=2:gosub drawpiece
  603.  
  604. x1=320:y1=320:piece=2:gosub drawpiece
  605. x1=390:piece=3:gosub drawpiece
  606. x1=460:gosub drawpiece
  607. x1=510:piece=2:gosub drawpiece
  608.  
  609. x1=320:y1=380:piece=2:gosub drawpiece
  610. x1=390:piece=4:gosub drawpiece
  611. x1=460:gosub drawpiece
  612. x1=510:piece=2:gosub drawpiece
  613.  
  614. x1=320:y1=440:piece=3:gosub drawpiece
  615. x1=390:piece=100:gosub drawpiece
  616. x1=460:gosub drawpiece
  617.  
  618. x1=20:y1=500:piece=1:gosub drawpiece
  619. x1=90:piece=101:gosub drawpiece
  620.  
  621. x1=180:y1=500:piece=2:gosub drawpiece
  622. x1=250:piece=102:gosub drawpiece
  623.  
  624. x1=340:y1=500:piece=3:gosub drawpiece
  625. x1=410:piece=103:gosub drawpiece
  626.  
  627. x1=500:y1=500:piece=4:gosub drawpiece
  628. x1=570:piece=104:gosub drawpiece
  629.  
  630. setrgb 1,255,255,255
  631. text 118,65,"+ ="
  632. text 118,125,"+ ="
  633. text 118,185,"+ ="
  634. text 118,245,"+ ="
  635. text 118,305,"+ ="
  636. text 118,365,"+ ="
  637. text 118,425,"+ ="
  638. text 418,65,"+ ="
  639. text 418,125,"+ ="
  640. text 418,185,"+ ="
  641. text 418,245,"+ ="
  642. text 418,305,"+ ="
  643. text 418,365,"+ ="
  644. text 418,425,"+ ="
  645. text 495,435,"X"
  646. text 85,485,"to"
  647. text 245,485,"to"
  648. text 405,485,"to"
  649. text 565,485,"to"
  650.  
  651. setrgb 1,0,0,0
  652. line 0,460 to 640,460
  653. setdispbuf curbuf
  654. repeat
  655. joypad=peek("port1")
  656. until (joypad=0)
  657. return
  658. rem Insertion Point 8
  659. rem #####################################################
  660. label drawboxback
  661. cbr=selectr(selection)
  662. cbg=selectg(selection)
  663. cbb=selectb(selection)
  664. setrgb 1,cb*cbr,cb*cbg,cb*cbb
  665. fill triangle x1,y1 to x1,y1-40 to x1+30,y1-55
  666. fill triangle x1,y1 to x1+30,y1-55 to x1+30,y1-15
  667. fill triangle x1+30,y1-15 to x1+30,y1-55 to x1+60,y1-40
  668. fill triangle x1+30,y1-15 to x1+60,y1-40 to x1+60,y1
  669.  
  670. setrgb 1,0,0,0
  671. line x1,y1 to x1+30,y1-15
  672. line x1+30,y1-15 to x1+60,y1
  673. line x1+30,y1-25 to x1+30,y1-55
  674. line x1,y1-40 to x1+30,y1-55
  675. line x1+30,y1-55 to x1+60,y1-40
  676. return
  677.  
  678. rem #####################################################
  679. label drawboxfront
  680. setrgb 1,0,0,0
  681. line x1,y1 to x1,y1-40
  682. line x1+60,y1 to x1+60,y1-40
  683. line x1+30,y1+25 to x1+30,y1-25
  684. line x1,y1-40 to x1+30,y1-25
  685. line x1+30,y1-25 to x1+60,y1-40
  686. return
  687. rem Insertion Point 1
  688. rem #####################################################
  689. label drawgem
  690. setrgb 1,r1,g1,b1
  691. fill triangle x1+30,y1 to x1+22,y1-20 to x1+38,y1-20
  692. setrgb 1,r2,g2,b2
  693. fill triangle x1+30,y1 to x1+10,y1-25 to x1+22,y1-20
  694. setrgb 1,r3,g3,b3
  695. fill triangle x1+30,y1 to x1+50,y1-25 to x1+38,y1-20
  696. setrgb 1,r4,g4,b4
  697. fill triangle x1+10,y1-25 to x1+15,y1-33 to x1+25,y1-28
  698. fill triangle x1+10,y1-25 to x1+25,y1-28 to x1+22,y1-20
  699. setrgb 1,r5,g5,b5
  700. fill triangle x1+38,y1-20 to x1+35,y1-28 to x1+45,y1-33
  701. fill triangle x1+38,y1-20 to x1+45,y1-33 to x1+50,y1-25
  702. setrgb 1,r6,g6,b6
  703. fill triangle x1+22,y1-20 to x1+25,y1-28 to x1+35,y1-28
  704. fill triangle x1+22,y1-20 to x1+35,y1-28 to x1+38,y1-20
  705. setrgb 1,r7,g7,b7
  706. fill triangle x1+15,y1-33 to x1+25,y1-28 to x1+25,y1-36
  707. fill triangle x1+25,y1-28 to x1+25,y1-36 to x1+35,y1-36
  708. fill triangle x1+25,y1-28 to x1+35,y1-36 to x1+35,y1-28
  709. fill triangle x1+35,y1-28 to x1+35,y1-36 to x1+45,y1-33
  710. return
  711.  
  712. rem Insertion Point 5
  713. rem #####################################################
  714. label drawsolid
  715. fill triangle x1+30,y1 to x1+10,y1-25 to x1+50,y1-25
  716. fill triangle x1+10,y1-25 to x1+15,y1-33 to x1+50,y1-25
  717. fill triangle x1+15,y1-33 to x1+25,y1-36 to x1+50,y1-25
  718. fill triangle x1+25,y1-36 to x1+35,y1-36 to x1+50,y1-25
  719. fill triangle x1+35,y1-36 to x1+45,y1-33 to x1+50,y1-25
  720. return
  721.  
  722. rem #####################################################
  723. label drawgemout
  724. triangle x1+30,y1 to x1+22,y1-20 to x1+38,y1-20
  725. triangle x1+30,y1 to x1+10,y1-25 to x1+22,y1-20
  726. triangle x1+30,y1 to x1+50,y1-25 to x1+38,y1-20
  727. line x1+10,y1-25 to x1+15,y1-33
  728. line to x1+25,y1-28
  729. line to x1+22,y1-20
  730.  
  731. line x1+25,y1-28 to x1+35,y1-28
  732. line to x1+38,y1-20
  733.  
  734. line x1+35,y1-28 to x1+45,y1-33
  735. line to x1+50,y1-25
  736.  
  737. line x1+15,y1-33 to x1+25,y1-36
  738. line to x1+35,y1-36
  739. line to x1+45,y1-33
  740. return
  741.  
  742. rem #####################################################
  743. label drawblock
  744. setrgb 1,80,50,50
  745. fill triangle x1,y1 to x1,y1-25 to x1+30,y1-10
  746. fill triangle x1,y1 to x1+30,y1-10 to x1+30,y1+15
  747.  
  748. setrgb 1,100,70,70
  749. fill triangle x1+30,y1+15 to x1+30,y1-10 to x1+60,y1-25
  750. fill triangle x1+30,y1+15 to x1+60,y1-25 to x1+60,y1
  751.  
  752. setrgb 1,120,90,90
  753. fill triangle x1,y1-25 to x1+30,y1-40 to x1+30,y1-10
  754. fill triangle x1+30,y1-10 to x1+30,y1-40 to x1+60,y1-25
  755. return
  756.  
  757. rem #####################################################
  758. label drawpiece
  759. if piece=1 then
  760. r1=200:g1=200:b1=0
  761. r2=100:g2=100:b2=0
  762. r3=255:g3=255:b3=100
  763. r4=100:g4=100:b4=50
  764. r5=255:g5=255:b5=150
  765. r6=200:g6=200:b6=50
  766. r7=200:g7=200:b7=100
  767. gosub drawgem
  768. return
  769. fi
  770.  
  771. if piece=2 then
  772. r1=0:g1=180:b1=0
  773. r2=0:g2=100:b2=0
  774. r3=100:g3=255:b3=100
  775. r4=50:g4=100:b4=50
  776. r5=150:g5=255:b5=150
  777. r6=50:g6=200:b6=50
  778. r7=100:g7=200:b7=100
  779. gosub drawgem
  780. return
  781. fi
  782.  
  783. if piece=3 then
  784. r1=200:g1=0:b1=0
  785. r2=100:g2=0:b2=0
  786. r3=255:g3=100:b3=100
  787. r4=100:g4=50:b4=50
  788. r5=255:g5=150:b5=150
  789. r6=200:g6=50:b6=50
  790. r7=200:g7=100:b7=100
  791. gosub drawgem
  792. return
  793. fi
  794.  
  795. if piece=4 then
  796. r1=0:g1=0:b1=200
  797. r2=0:g2=0:b2=100
  798. r3=100:g3=100:b3=255
  799. r4=50:g4=50:b4=100
  800. r5=150:g5=150:b5=255
  801. r6=50:g6=50:b6=200
  802. r7=100:g7=100:b7=200
  803. gosub drawgem
  804. return
  805. fi
  806.  
  807. rem Insertion Point 6
  808. if piece=100 then
  809. gosub drawblock
  810. return
  811. fi
  812.  
  813. if piece=101 then
  814. setrgb 1,100,100,0
  815. gosub drawsolid
  816. setrgb 1,255,255,0
  817. gosub drawgemout
  818. return
  819. fi
  820.  
  821. if piece=102 then
  822. setrgb 1,0,100,0
  823. gosub drawsolid
  824. setrgb 1,0,255,0
  825. gosub drawgemout
  826. return
  827. fi
  828.  
  829. if piece=103 then
  830. setrgb 1,100,0,0
  831. gosub drawsolid
  832. setrgb 1,255,0,0
  833. gosub drawgemout
  834. return
  835. fi
  836.  
  837. if piece=104 then
  838. setrgb 1,0,0,100
  839. gosub drawsolid
  840. setrgb 1,0,0,255
  841. gosub drawgemout
  842. return
  843. fi
  844.  
  845. return
  846.  
  847. rem ##################################
  848. label drawboard
  849. for y=10 to 1 step -1
  850. for x=1 to 10
  851.  
  852. rem Insertion Point 9
  853. cursor=0
  854. if cx=x and cy=y then cursor=1 fi
  855.  
  856. x1=x*30+y*30-40
  857. y1=x*15-y*15+250
  858. if mod(x+y,2)=0 then
  859. setrgb 1,150,150,150
  860. else
  861. setrgb 1,50,50,100
  862. fi
  863.  
  864. rem Insertion Point 10
  865. if cursor=1 then
  866. cbr=selectr(selection)
  867. cbg=selectg(selection)
  868. cbb=selectb(selection)
  869. setrgb 1,cb*cbr,cb*cbg,cb*cbb
  870. fi
  871.  
  872. fill triangle x1,y1 to x1+30,y1-15 to x1+60,y1
  873. fill triangle x1,y1 to x1+60,y1 to x1+30,y1+15
  874.  
  875. rem Insertion Point 11
  876. if cursor=1 then
  877. gosub drawboxback
  878. fi
  879. rem Insertion Point 2
  880. piece=board(x,y)
  881. if piece>0 then
  882. gosub drawpiece
  883. fi
  884. rem Insertion Point 12
  885. if cursor=1 then
  886. gosub drawboxfront
  887. fi
  888.  
  889. next x
  890. next y
  891.  
  892. setrgb 1,50,50,100
  893. setrgb 2,50,50,100
  894. setrgb 3,0,0,50
  895. gtriangle 20,250 to 320,400 to 20,270
  896. gtriangle 320,400 to 620,250 to 320,420
  897. setrgb 1,0,0,50
  898. gtriangle 20,270 to 320,400 to 320,420
  899. gtriangle 320,420 to 620,250 to 620,270
  900. return
  901.  
  902. rem ##################################
  903. label flipscreen
  904. setdispbuf curbuf
  905. curbuf=1-curbuf
  906. setdrawbuf curbuf
  907. return
  908.  
  909. rem ##################################
  910. label initialise
  911. curbuf=0
  912. open window 640,512
  913.  
  914. rem Insertion Point 3
  915. dim board(10,10)
  916. restore levels
  917. read maxlevels
  918. dim levels(maxlevels,100,3)
  919. dim levelc(maxlevels)
  920. dim leveldone(maxlevels)
  921. for level=1 to maxlevels
  922. read numpiece
  923. levelc(level)=numpiece
  924. for a=1 to numpiece
  925. for b=1 to 3
  926. read levels(level,a,b)
  927. next b
  928. next a
  929. next level
  930.  
  931. rem Insertion Point 13
  932. cb=0:cbd=20
  933. dim selectr(4)
  934. dim selectg(4)
  935. dim selectb(4)
  936. restore cursorcolours
  937. for a=0 to 4
  938. read selectr(a)
  939. read selectg(a)
  940. read selectb(a)
  941. next a
  942. cdelaybase=10:cdelay=cdelaybase:cwait=0
  943. cx=5:cy=5
  944. slide=0
  945. rem Insertion Point 24
  946. gosub setupinstructions
  947.  
  948. rem Insertion Point 27
  949. numtgem=4
  950. dim tgemx(numtgem)
  951. dim tgemy(numtgem)
  952. dim tgemp(numtgem)
  953. dim tgems(numtgem)
  954. return
  955.  
  956. rem Insertion Point 4
  957.  
  958.  
  959. rem Insertion Point 14
  960. label cursorcolours
  961. data 1,1,1
  962. data 1,1,0
  963. data 0,1,0
  964. data 1,0,0
  965. data 0,0,1
  966.  
  967.  
  968. label levels
  969. data 4 : rem how many levels
  970. data 10 : rem how many pieces
  971. data 1,1,104 : rem x, y, piece number
  972. data 9,1,100
  973. data 10,1,100
  974. data 9,2,100
  975. data 9,3,100
  976. data 10,3,100
  977. data 10,2,4
  978. data 10,4,1
  979. data 4,6,1
  980. data 6,3,2
  981.  
  982. data 5
  983. data 1,1,103
  984. data 7,2,4
  985. data 9,3,4
  986. data 6,6,1
  987. data 10,10,103
  988.  
  989. data 10
  990. data 1,1,1
  991. data 9,1,100
  992. data 10,1,103
  993. data 9,2,100
  994. data 9,3,100
  995. data 10,3,100
  996. data 10,2,4
  997. data 10,4,1
  998. data 4,6,1
  999. data 6,3,2
  1000.  
  1001. data 24
  1002. data 4,2,2
  1003. data 8,4,4
  1004. data 2,7,2
  1005. data 7,7,2
  1006. data 1,9,100
  1007. data 2,9,100
  1008. data 3,9,100
  1009. data 4,9,100
  1010. data 5,9,100
  1011. data 6,9,100
  1012. data 7,9,100
  1013. data 8,9,100
  1014. data 9,9,100
  1015. data 1,8,100
  1016. data 2,8,100
  1017. data 1,10,103
  1018. data 2,10,4
  1019. data 3,10,100
  1020. data 4,10,1
  1021. data 5,10,100
  1022. data 6,10,2
  1023. data 7,10,100
  1024. data 8,10,4
  1025. data 9,10,100
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement