home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / magazines / c=hacking / code / 09 / init3d2.0.prg (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1995-02-01  |  2.3 KB  |  82 lines
  1. 0 rem holiday 1994 -- slj 12/28/94
  2. 1 rem inspired by j. charnetski
  3. 2 rem and others.
  4. 3 rem this also sets up tables for
  5. 4 rem the program cube3d v2.0
  6. 5 poke51,0:poke52,128:poke55,0:poke56,128:clr
  7. 9 dim v(36)
  8. 10 poke53280,0:poke53281,0:gosub400
  9. 20 a$="*****************":s=1
  10. 25 r$="":d$=""
  11. 30 fori=1to13:s=s+2*(i=4)+3*(i=8)
  12. 40 print""left$(d$,i)left$(r$,21-s)left$(a$,2*s-1);:s=s+1:next
  13. 50 print""left$(d$,16)left$(r$,19)"[149]   [157][157][157]   [157][157][157]   [146]";
  14. 60 print"("
  15. 62 print"[154]"d$"patience...";
  16. 65 fori=1to18
  17. 70 r=int(rnd(1)*640+0.5)+1024:if peek(r)<>32then70
  18. 80 v(i)=r+54272:poker,46:pokev(i),int(rnd(0)*7+1):next
  19. 85 fori=19to36
  20. 90 r=int(rnd(1)*640+0.5)+1024:if peek(r)<>42then90
  21. 95 v(i)=r+54272:poker,81:pokev(i),int(rnd(0)*7+1):next
  22. 96 print"[154]"d$"patience... [212]"d$;
  23. 97 f$="[180][157][181][157][161][157][182][157][170][157] ":c1=1:c2=0:r=1
  24. 98 s2$=" peace and blessings to you in 1995  "
  25. 99 s$=" naughty or nice?   "
  26. 100 rem
  27. 102 rem set up trig tables
  28. 103 rem ------------------
  29. 105 bs=35968:bc=bs+128:bz=bc+128:bm=bz+384
  30. 110 a=0:da=(NULL)/60
  31. 120 fori=0to120:s=int(32*sin(a)+0.5):c=int(32*cos(a)+0.5):a=a+da
  32. 130 if s<0 then s=256+s
  33. 140 if c<0 then c=256+c
  34. 150 pokebs+i,s:pokebc+i,c
  35. 160 rem
  36. 162 rem -----------------
  37. 165 r2=peek(v(18+r)):r1=peek(v(r))
  38. 170 pokev(r),r2:pokev(r+18),r1:r=r+1:ifr=19thenr=1
  39. 175 ifc1>12thenc1=1:c2=c2+1:print"[157]"mid$(s$,c2,1)"[146]";:goto190
  40. 180 printmid$(f$,c1,2);:c1=c1+2
  41. 185 rem -----------------
  42. 190 next i
  43. 195 rem
  44. 200 c2=0:s$=s2$:print""d$"             nice!                   [153][180]"d$;
  45. 210 fori=1to9
  46. 220 r=int(rnd(0)*3)*40+int(rnd(0)*13)+1759:ifpeek(r)<>32then220
  47. 230 poker,219:poker+54272,int(rnd(0)*8+1):next:r=1
  48. 233 rem
  49. 234 rem set up mult and proj tables
  50. 235 rem ---------------------------
  51. 240 d=170:z0=5
  52. 250 k=int(64*2/z0+0.5):poke182,k
  53. 260 forj=0to255:z=j:if z>127 thenz=z-256
  54. 270 q=int(d/(z0-z/64)+0.5)
  55. 273 if q>127 then q=127
  56. 275 if q<-127 then q=-127
  57. 276 if q<0 then q=256+q
  58. 280 pokebz+j,q
  59. 290 s=j:if s>150 then s=256-s
  60. 300 q=int(s*s/256+0.5)
  61. 310 poke bm+j,q:poke bm+j+256,q
  62. 315 rem
  63. 316 rem --------
  64. 318 r2=peek(v(18+r)):r1=peek(v(r))
  65. 320 pokev(r),r2:pokev(r+18),r1:r=r+1:ifr=19thenr=1
  66. 330 ifc1>12thenc1=1:c2=c2+1:print"[157]"mid$(s$,c2,1)"[146]";:goto350
  67. 340 printmid$(f$,c1,2);:c1=c1+2
  68. 345 rem --------
  69. 350 next j
  70. 360 sys32768:print"ho! ho! ho!"
  71. 361 print"email sjudd@nwu.edu "
  72. 362 print" -or- aa601@cfn.cs.dal.ca "
  73. 363 print"or write to: "
  74. 364 print"    steve judd         "
  75. 365 print"    1100 grove #bw     "
  76. 366 print"    evanston, il 60201 "
  77. 370 print"                       "
  78. 390 end
  79. 400 poke214,22:print"[150]":fori=1to38:a$=a$+"[214]":b$=b$+" ":next
  80. 410 a$=a$+"[214][214][145][145]":fori=1to24:printa$;:next
  81. 420 print"";:b$=b$+"":fori=1to22:printb$;:next:print"":return
  82.