Sorry your browser is not supported!

rem Program Name: Procedural 2D Tree
rem Author: OBese87
rem ==================
set display mode 1024,768,32
hide mouse
randomize timer()
sync on
sync rate 0

set text font "arial",1
set text size 14
set text to italic

rem make screen buffers
create bitmap 1,1024,768
create bitmap 2,1024,768
buff = 1
set current bitmap buff
ink -2,0:text 974,750,"OBese87"
sync
levels = 12

rem === MAIN ===
do
 time = timer()
 rem run 3 times to look more interesting
 for i = 1 to 3
   tree(levels,150.0+i*20,0,0,0)
 next i
 rendertime = timer()-time
 if rendertime<1000 then wait 1000-rendertime else wait 40
 copy bitmap buff,0
 sync
 buff = 1+(1-buff)
 set current bitmap buff
 cls:ink -2,0:text 974,750,"OBese87"
loop
end

rem === FUNCTIONS ===
function tree(l,h#,x,y,a)
  rem leaf or branch?
  if l>=1
    ink rgb(140,100,0),0
    xe = x+sin(a)*h#
    ye = y-cos(a)*h#
    line 512+x,700+y,512+xe,700+ye
    rem generate two branches
    ang=wrapvalue(a+rnd(20)-30)
    tree(l-1,h#/1.4,xe,ye,ang)
`    a=wrapvalue(a+rnd(30)+30)
    a=wrapvalue(a+rnd(20)+30)
    tree(l-1,h#/1.4,xe,ye,a)
  else
    ink rgb(0,140+rnd(60),0),0
    box x+510,y+699,x+514,y+701
  endif
endfunction

rem Program Name: Procedural 2D Tree
rem Author: OBese87
rem ==================
set display mode 1024,768,32
hide mouse
randomize timer()
sync on
sync rate 0

levels = 9
gosub backdrop
rem screen buffer
create bitmap 1,1024,768
set current bitmap 1

rem === MAIN ===
do
 copy bitmap 3,1
 for tree = 0 to rnd(20)+10
   y = rnd(30)+50 : rem y acts as height but also distance from the viewer
   tree(levels,160.0+rnd(20)-y*2,rnd(1024),y,0)
 next tree
 copy bitmap 1,0

 for gam = 0 to 255
   set gamma gam,gam,gam
   sync
 next gam
 wait 2000
 for gam = 255 to 0 step -1
   set gamma gam,gam,gam
   sync
 next gam
loop
end

rem === FUNCTIONS ===
function tree(l,h#,x,y,a)
  rem leaf or branch?
  if l>=1
    ink rgb(100,50,10),0
    xe = x+sin(a)*h#
    ye = y+cos(a)*h#
    line x,767-y,xe,767-ye
    rem generate more branches
    b = rnd(2)
    for i = 0 to b
      ang=wrapvalue(a+(i*40-b*20)+rnd(20)-10)
      tree(l-1,h#/1.4,xe,ye,ang)
    next i
  else
    ink rgb(0,100+rnd(60),0),0
    box x-2,766-y,x+2,768-y
  endif
endfunction

rem === SUBROUTINES ===
backdrop:
  rem Store formatting entered with.
  size = text size()
  font$ = text font$()
  style = text style()
  rem Invert colours for white to colour fade.
  r = 255 : g = 128 : b = 0
  sw = screen width()
  sh = screen height()
  create bitmap 3,sw,sh
  for y = 0 to sh-1
    yfct# = (y/(sh*1.0))
    rr = 255-yfct#*r
    gg = 255-yfct#*g
    bb = 255-yfct#*b
    ink rgb(rr,gg,bb),0
    box 0,y,sw-1,y
  next y
  rem extra ground gradient specific to this program
  r = 90 : g = 64 : rem new values and /2 to get darker colours
  for y = 680 to sh-1
    yfct# = (y-680)/(sh-680+.0)
    rr = 128-yfct#*r
    gg = 128-yfct#*g
    ink rgb(rr,gg,0),0
    box 0,y,sw-1,y
  next y

  set text font "arial",1
  set text size 14
  set text to italic
  ink -2,0
  text sw-50,sh-16,"OBese87"
  set current bitmap 0
return
`//

cast_shadow(obj,shadow,sangle#,shadowimg,posx#,posy#,posz#)

remstart
   ==============================================================
   =  Title  : Cast an animated shadow
   =  Author : latch
   =  Date   : 01/28/2010
   =  Update :
   =  Version: .01
   ==============================================================
   Comments    Using a mesh, we should be able to create a fake
               shadow of an animated object.
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,16
   sync on
   sync rate 0
   hide mouse

rem =============================================================
rem = MAIN
rem =============================================================
_main:
   gosub _init
   sangle#=127
   point camera object position x(figure),object position y(figure),object position z(figure)
   do

      if timer()-tim > 50
         cast_shadow(figure,2,sangle#,0,0.0,-2.0*osy#,0.0)
         tim=timer()
      endif
      yrotate object figure,wrapvalue(object angle y(figure)+1)

      text 0,0,"fps = "+str$(screen fps())

      gosub _move_camera
      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _init:
      rem make animated figure
      figure=stick_man(1)

      rem turn animation on
      loop object figure

      rem get offsets
      osx#=object size x(figure)
      osy#=object size y(figure)
      osz#=object size z(figure)

      rem make matrix
      make matrix 1,1000,1000,25,25
      position matrix 1,-500,-2.0*osy#,-500
   return
`----------------------------------------------------------------
   _move_camera:
      yang#=wrapvalue(camera angle y()+mousemovex())
      xang#=wrapvalue(camera angle x()+mousemovey())
      rotate camera xang#,yang#,0
      move camera (upkey()-downkey())*5
   return

rem =============================================================
rem = FUNCTIONS
rem =============================================================

   function is_even(num)
      if num & 1 then exitfunction 0
   endfunction 1
`----------------------------------------------------------------
   function avail_obj(obj)
      while object exist(obj)=1
         inc obj
      endwhile
   endfunction obj
`-----------------------------------------------------------------

function stick_man(obj)
   rem =============================================================
   rem = Create character
   rem =============================================================

   rem variables
   body=avail_obj(obj)
   joint=avail_obj(body+1)
   head=avail_obj(body+2)
   chimney=avail_obj(body+3)
   bone=body

         rem right leg
         r_hip=1:r_thigh=2:r_knee=3:r_shin=4

         rem left leg
         l_hip=5:l_thigh=6:l_knee=7:l_shin=8

         rem right arm
         r_shold=9:r_bi=10:r_elbow=11:r_arm=12

         rem left arm
         l_shold=13:l_bi=14:l_elbow=15:l_arm=16

         rem head
         kneck=17:head=18:chimney=19

   rem body parts
   make object cylinder body,50
   scale object body,25,70,25
   make mesh from object bone,body
   scale object body,100,100,100
   make object cube head,25
   make mesh from object head,head
   make object cylinder chimney,5
   scale object chimney,60,400,60
   make mesh from object chimney,chimney

   rem joints
   make object sphere joint,50
   scale object joint,36,36,36
   make mesh from object joint,joint
   scale object joint,100,100,100

   rem create limbs
   count = 0
   for lmb=1 to 16
      inc count
      if is_even(lmb)=1
         add limb body,lmb,bone
      else
         add limb body,lmb,joint
      endif

      rem link limbs
      if count > 1
         link limb body,lmb,lmb-1
      endif

      if count = 4 then count = 0

   next lmb

   rem neck head and smoke stack
   add limb body,kneck,bone
   add limb body,head,head
   link limb body,head,kneck
   add limb body,chimney,chimney
   link limb body,chimney,head

   rem initial position of limbs
         rem right leg
   offset limb body,r_hip,-12,-26,0
   offset limb body,r_thigh,0,-20,0
   offset limb body,r_knee,0,-20,0
   offset limb body,r_shin,0,-20,0

         rem left leg
   offset limb body,l_hip,12,-26,0
   offset limb body,l_thigh,0,-20,0
   offset limb body,l_knee,0,-20,0
   offset limb body,l_shin,0,-20,0

         rem right arm
   offset limb body,r_shold,-33,20,0
   offset limb body,r_bi,-2,-20,0
   offset limb body,r_elbow,0,-20,0
   rotate limb body,r_elbow,300,0,0
   offset limb body,r_arm,0,-20,0

         rem left arm
   offset limb body,l_shold,33,20,0
   offset limb body,l_bi,2,-20,0
   offset limb body,l_elbow,0,-20,0
   rotate limb body,l_elbow,300,0,0
   offset limb body,l_arm,0,-20,0

         rem head
   offset limb body,kneck,0,20,0
   offset limb body,head,0,20,0
   offset limb body,chimney,5,20,-8

   rem object animation
   set object keyframe body,0
   rotate limb body,r_hip,310,0,0
   rotate limb body,r_knee,60,0,0
   rotate limb body,r_shold,30,0,0
   rotate limb body,l_hip,20,0,0
   rotate limb body,l_knee,20,0,0
   rotate limb body,l_shold,310,0,0
   set object keyframe body,10
   rotate limb body,r_hip,0,0,0
   rotate limb body,r_knee,3,0,0
   rotate limb body,r_shold,330,0,0
   rotate limb body,l_hip,340,0,0
   rotate limb body,l_knee,60,0,0
   rotate limb body,l_shold,0,0,0
   set object keyframe body,20
   rotate limb body,r_hip,20,0,0
   rotate limb body,r_knee,30,0,0
   rotate limb body,r_shold,300,0,0
   rotate limb body,l_hip,310,0,0
   rotate limb body,l_knee,30,0,0
   rotate limb body,l_shold,20,0,0
   set object keyframe body,28
   rotate limb body,l_hip,0,0,0
   rotate limb body,l_knee,3,0,0
   rotate limb body,l_shold,359,0,0
   rotate limb body,r_hip,359,0,0
   rotate limb body,r_knee,10,0,0
   rotate limb body,r_shold,0,0,0
   set object keyframe body,38

   rem cleanup unneeded meshes and objects
   delete object chimney
   delete mesh chimney
   delete object head
   delete mesh head
   delete object joint
   delete mesh joint
   delete mesh bone

endfunction body
`-----------------------------------------------------------------------------
   function cast_shadow(obj,shadow,sangle#,shadowimg,posx#,posy#,posz#)
      if object exist(shadow) then delete object shadow
      rem use obj to build shadow and cast it at angle sangle
      rem move the original object to the origin
      ox#=object position x(obj)
      oy#=object position y(obj)
      oz#=object position z(obj)
      position object obj,0,0,0

      rem create a mesh out of the object
      make mesh from object obj,obj
      make object shadow,obj,shadowimg
      delete mesh obj

      rem reposition orignal object
      position object obj,ox#,oy#,oz#

      rem rotate the shadow on it's y axis to opposite
      rem direction of sangle
      yang#=wrapvalue(sangle#)
      rotate limb shadow,0,0,yang#,0
      offset limb shadow,0,0,object size y(shadow)/2.0,0
      make mesh from object shadow,shadow
      delete object shadow
      make object shadow,shadow,shadowimg
      delete mesh shadow

      rotate object shadow,90,0,wrapvalue(sangle#)
      position object shadow,ox#+posx#,oy#+posy#,oz#+posz#

      scale object shadow,100,100,0
      ghost object on shadow,1
      if shadowimg=0 then color object shadow,rgb(64,64,64)

   endfunction

set display mode 1024,768,32
hide mouse
sync rate 0
sync on
set text font "comic sans ms",1
set text size 40

scale = 50 : rem size of the boxes drawn to screen, nothing to do with the actual board squares.
width = 10 : rem width in squares of each row on the board.

crappy_goto:
repeat
  print "What size would you like the board? (Width X Width)"
  input "Width = ?  "; width

  print "The board will be ";width*width;" squares. Are you sure?"
  input "(Y/N)? ";yn$

  if width>20 then print "Too big!" : yn$="N":sync:wait key
  cls
until upper$(yn$) = "Y"
scale = 767/width
set text size scale*.66

rem === MAIN ===
for i = 0 to (width*width)-1
  row = get_row(i,width)
  column = get_column(i,width)

  rem define two inks
  inka = 16711680 : inkb = 65535
  rem swap inks to create a checkerboard effect
  if xor(column&1,row&1) then inka=inka+inkb : inkb=inka-inkb : inka=inka-inkb

  rem get correct number to print on square
  rem odd and even rows go in opposite directions
  if row&1 then num = (row+1)*width - column else num = row*width + column+1
  rem change row so we start from the bottom and go up
  row = width-1 - row

  ink inka,0
  box column*scale,row*scale,(column+1)*scale,(row+1)*scale
  if column&1 then ink 65535,0 else ink 65536*255,0
  ink inkb,0
`  set cursor column*scale+4,row*scale+4
`  print num
   text column*scale,row*scale, str$(num)
next i

sync
wait key
goto crappy_goto
end

rem === FUNCTIONS ===
function get_row(i,width)
  row = i / width
endfunction row
`//
function get_column(i,width)
  column = i - ((i/width)*width)
endfunction column
`//
function xor(a,b)
  c = (a|b)-(a&b)
endfunction c
`//

rem Program Name: Snakes & Ladders
rem Author: OBese87
rem Last Update: 20th March
rem ==================
remstart
=== Variables Used ===
scale - size of the boxes drawn to screen, nothing to do with the actual board squares.
squares - total number of squares on the board.
width - width in squares of each row on the board.
column - the column on the board.
row - the row on the board.
num - the printed number for that square (first and last squares are printed "Start" and "Finish").
inka, inkb - two inks that are used alternately as foreground and background to produce a checkered effect.
remend
set display mode 1024,768,32
hide mouse
sync rate 0
sync on
create bitmap 1,1024,768 :rem make bitmap for storing board image
set current bitmap 0
set text font "comic sans ms",1
set text size 40

crappy_goto:
gosub get_board_dimensions
gosub draw_board

rem === MAIN ===
copy bitmap 1,0
sync
wait key
cls
goto crappy_goto
end

rem === SUBROUTINES ===
draw_board:
  squares = width*width
  scale = 767/width
  set text size scale*.45
  set current bitmap 1

  for i = 0 to squares-1
    row = get_row(i,width)
    column = get_column(i,width)

    rem Define two inks.
    inka = 128 : inkb = 65535
    rem Swap inks on alternate squares to create a checkerboard effect.
    if xor(column&1,row&1) then inka=inka+inkb : inkb=inka-inkb : inka=inka-inkb
    rem Get correct number to print on square. Odd and even rows go in opposite directions.
    if row&1 then num = (row+1)*width - column else num = row*width + column+1
    rem Change row so we start from the bottom and go up.
    row = width-1 - row
    rem Draw square.
    ink inka,0
    box column*scale,row*scale,(column+1)*scale,(row+1)*scale
    rem Print number on square.
    ink inkb,0
    select num
      case 1 : text column*scale,row*scale, "Start" : endcase
      case squares : text column*scale,row*scale, "Finish" : endcase
      case default : text column*scale,row*scale, str$(num) : endcase
    endselect
  next i

  set current bitmap 0
return
`//

get_board_dimensions:
  repeat
    print "What size would you like the board? (Width x Width)"
    input "Width = ?  "; width

    print "The board will be ";width*width;" squares. Are you sure?"
    input "(Y/N)? ";yn$

    if width>16 then print "Too big! 16 x 16 is the largest allowed." : yn$="N":sync:wait key
    cls
  until upper$(yn$) = "Y"
return
`//

rem === FUNCTIONS ===
function get_row(i,width)
  row = i / width
endfunction row
`//
function get_column(i,width)
  column = i - ((i/width)*width)
endfunction column
`//
function xor(a,b)
  c = (a|b)-(a&b)
endfunction c
`//

randomize timer()
sync on : sync rate 60

set display mode 800,600,32
backdrop off : hide mouse
dim dice(5) : dim okay(6) : dim colr(8)
dim p1(5,20) : dim change(5) : dim num_spins(4)
dim name$(4) : dim cats_full(4) : dim score(4)
for i = 1 to 20 : for x = 1 to 5 : p1(x,i) = 0 : next x : next i
for i = 1 to 4 : num_spins(i) = 0 : cats_full(i) = 0 : next i
turn = 1
SW = screen width() : SH = screen height()
white = rgb(255,255,255) : colr(1) = white
red = rgb(225,0,0) : colr(2) = red
blue = rgb(0,35,182) : colr(3) = blue
green = rgb(0,150,30) : colr(4) = green
purple = rgb(255,0,255) : colr(5) = purple
grey = rgb(128,128,128) : colr(6) = grey
brown = rgb(128,64,0) : colr(7) = brown
pink = rgb(255,128,128) : colr(8) = pink
gosub TITLE_SCREEN
gosub MAKE_IMGS
show mouse
if NumPlayers > 1
` player versus the other humans
  repeat
    cf = 0
    for turn = 1 to NumPLayers
      if cats_full(turn) = 0
        gosub BEGIN
      else
        inc cf,1
      endif
    next turn
  until cf = NumPlayers
  gosub DeclareWinner
else
` player versus the computer
  repeat
    cf = 0
    if cats_full(1) = 0
      turn = 1 : gosub BEGIN
    else
      cf = 1
    endif
    if cats_full(2) = 0
      gosub CPU_TURN
    else
      inc cf,1
    endif
  until cf = 2
  gosub DeclareWinner
` end of game totals and comparison
endif
for i = 1 to 6
  if sprite exist(i) = 1 then delete sprite i
  if image exist(i) = 1 then delete image i
next i
end

BEGIN:
` setup screen
 cls green
 ink blue,0
 box 0,420,SW - 1,SH - 1
 ink white,0
 cat_selected = 0
while cat_selected = 0
  center text SW * .5,0,name$(turn)
  if num_spins(turn) = 0 then gosub ROLL_DICE : gosub DP_ROLL
  if num_spins(turn) > 0 and num_spins(turn) < 3 then gosub RE_ROLL_DICE : gosub DP_ROLL
  s = SW - 150 : gosub PRINT_STATUS
  ink white,0
  if NumPlayers > 1 or turn = 1
    if num_spins(turn) < 2
      text 10,SH - 160, "Left Click on the die you want to change or click on the category you want."
      text 10,SH - 140, "Right click to spin."
    else
      text 10,SH - 160,"Select category by left clicking on it."
    endif
    sync
  else
  ` computer's turn
    text 10,SH - 60,"Computer is deciding what to do."
    sync
    wait 1000
  endif
  num_spins(turn) = num_spins(turn) + 1
  if num_spins(turn) < 3
    for i = 1 to 5 : change(i) = 0 : next i
    do
      mc = mouseclick() : mx = mousex() : my = mousey()
`      ink green,0
`      box 0,0,50,50
      ink white,0
 `     text 0,0,"mx: " + str$(mx)
 `     text 0,20,"my: " + str$(my)
      if mc = 1
        if my >= 19 and my <= 81 and mx < 390
          for i = 1 to 5
            if mx >= (((i - 1) * 70) + 50) and mx <= (((i - 1) * 70) + 110)
              if change(i) = 0
                change(i) = 1 : ink rgb(180,0,130),0
              else
                change(i) = 0 : ink rgb(0,150,30),0
              endif
              x = (((i - 1) * 70) + 44) : y = 16
              line x,y,x + 68,y
              line x + 68,y,x + 68,y + 68
              line x,y,x,y + 68
              line x,y + 68,x + 68,y + 68
            endif
          next i
        endif
        if mc = 1 and  mx >= (SW - 150)
          cat = ((my - 13) / 20) + 1 : dne = 0
          time# = timer() + 800
          if p1(turn,cat) > 0
            if cat = 15 and p1(turn,cat) > 0
            ` got more than one Iyahtzou
              p1(turn,cat) = p1(turn,cat) + 100
            else
              time# = timer() + 1250
              repeat
                text 100,100,"You already picked that!!" + str$(cat)
                sync
                dne = 1
          until timer() > time#
          ink green,0
          box 90,90,310,140
          ink white,0
        endif
      else
`        repeat
`          text 100,100,"picked cat #" + str$(cat)
`          sync
`        until timer() > time#
        p1(turn,cat) = p1(5,cat) : if p1(5,cat) = 0 then p1(turn,cat) = -1
        cat_selected = cat
      endif
      s = SW - 150 : gosub PRINT_STATUS
      sync
      wait 100
      if dne = 0 then exit
    endif

        while mc = 1
          mc = mouseclick()
          sync
        endwhile
      endif
      if mc = 2 then exit
      sync
    loop
  else
  ` user can only place it in a category
    mc = mouseclick() : mx = mousex() : my = mousey()
    if mc = 1 and  mx >= (SW - 150)
      cat = ((my - 13) / 20) + 1 : dne = 0
      time# = timer() + 800
      if p1(turn,cat) > 0
        if cat = 15 and p1(turn,cat) > 0
        ` got more than one Iyahtzou
          p1(turn,cat) = p1(turn,cat) + 100
        else
          time# = timer() + 1250
          repeat
            text 100,100,"You already picked that!!" + str$(cat)
            sync
            dne = 1
          until timer() > time#
          ink green,0
          box 90,90,310,140
          ink white,0
        endif
      else
`        repeat
`          text 100,100,"picked cat #" + str$(cat)
`          sync
`        until timer() > time#
        p1(turn,cat) = p1(5,cat) : if p1(5,cat) = 0 then p1(turn,cat) = -1
        cat_selected = cat
      endif
      s = SW - 150 : gosub PRINT_STATUS
      sync
      wait 100
      if dne = 0 then exit
    endif
  endif

endwhile
num_spins(turn) = 0
catCount = 0
for t = 1 to 16
  if p1(turn,t) <> 0 then inc catCount
next t
if catCount = 13 then cats_full(turn) = 1
return


PRINT_STATUS:
` enter with 's' equals where to draw the lines
ink white,0
line s,10,s + 149,10 : line s,10,s,SH - 200 : line s,SH - 200,s + 149,SH - 200 : line s + 149,10,s + 149,SH - 200
for j = 32 to 372 step 20
  line s,j,s + 149,j
next j
set text size 11
s = s + 5 : k = 15
if p1(turn,1) = 0
  ink blue,0
  text s + 120,k,str$(okay(1)) : p1(5,1) = okay(1)
else
  ink red,0
  a$ = str$(p1(turn,1)) : if a$ = "-1" then a$ = "0"
  text s + 120,k,a$
endif
text s,k,"Onesies:"
if p1(turn,2) = 0
  ink blue,0
  text s + 120,k + 20,str$(okay(2)*2) : p1(5,2) = okay(2) * 2
else
  ink red,0
  a$ = str$(p1(turn,2)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 20,a$
endif
text s,k + 20, "Twosies:"
if p1(turn,3) = 0
  ink blue,0
  text s + 120,k + 40,str$(okay(3)*3) : p1(5,3) = okay(3) * 3
else
  ink red,0
  a$ = str$(p1(turn,3)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 40,a$
endif
text s,k + 40, "Trays:"
if p1(turn,4) = 0
  ink blue,0
  text s + 120,k + 60, str$(okay(4)*4) : p1(5,4) = okay(4) * 4
else
  ink red,0
  a$ = str$(p1(turn,4)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 60,a$
endif
text s,k + 60, "Quads:      "
if p1(turn,5) = 0
  ink blue,0
  text s + 120,k + 80,str$(okay(5)*5) : p1(5,5) = okay(5) * 5
else
  ink red,0
  a$ = str$(p1(turn,5)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 80,a$
endif
text s,k + 80, "Quints:     "
if p1(turn,6) = 0
  ink blue,0
  text s + 120,k + 100,str$(okay(6)*6) : p1(5,6) = okay(6) * 6
else
  ink red,0
  a$ = str$(p1(turn,6)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 100,a$
endif
text s,k + 100, "Sixes:      "
` get sub-total for the top
ink purple,0
scoar = 0
for g = 1 to 6
  if p1(turn,g) <> -1 then scoar = scoar + p1(turn,g)
next g
text s,k + 120,"Sub-Total:"
text s + 120,k + 120,str$(scoar)
text s,k + 140,"Bonus"
ba = 0 : if scoar >= 63 then ba = 35
text s + 120,k + 140,str$(ba)
text s,k + 160,"Total Top:"
text s + 120,k + 160,str$(scoar + ba)
chance = okay(1) + okay(2) * 2 + okay(3) * 3 + okay(4) * 4 + okay(5) * 5 + okay(6) * 6
bscoar = 0
if p1(turn,10) = 0
  ink blue,0
  if three_of_a_kind = 1
    text s + 120,k + 180,str$(chance) : p1(5,10) = chance
  else
    text s + 120,k + 180,str$(three_of_a_kind) : p1(5,10) = three_of_a_kind
  endif
else
  ink red,0
  a$ = str$(p1(turn,10)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 180,a$
  if p1(turn,10) <> -1 then bscoar = bscoar + p1(turn,10)
endif
text s,k + 180,"Three of a kind:"
if p1(turn,11) = 0
  ink blue,0
  if four_of_a_kind = 1
    text s + 120,k + 200,str$(chance)  : p1(5,11) = chance
  else
    text s + 120,k + 200,str$( four_of_a_kind) : p1(5,11) = four_of_a_kind
  endif
else
  ink red,0
  a$ = str$(p1(turn,11)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 200,a$
  if p1(turn,11) <> -1 then bscoar = bscoar + p1(turn,11)
endif
text s,k + 200,"Four of a kind:"
if p1(turn,12) = 0
  ink blue,0
  if full_house = 1
    text s + 120,k + 220,"25" : p1(5,12) = 25
  else
    text s + 120,k + 220,str$(full_house) : p1(5,12) = full_house
  endif
else
  ink red,0
  a$ = str$(p1(turn,12)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 220,a$
  if p1(turn,12) <> -1 then bscoar = bscoar + p1(turn,12)
endif
text s,k + 220,"Full House:"
if p1(turn,13) = 0
  ink blue,0
  if small_strait = 1
    text s + 120,k + 240,"30" : p1(5,13) = 30
  else
    text s + 120,k + 240,str$(small_strait) : p1(5,13) = small_strait
  endif
else
  ink red,0
  a$ = str$(p1(turn,13)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 240,a$
  if p1(turn,13) <> -1 then bscoar = bscoar + p1(turn,13)
endif
text s,k + 240,"small straight:"
if p1(turn,14) = 0
  ink blue,0
  if large_strait = 1
    text s + 120,k + 260,"40" : p1(5,14) = 40
  else
    text s + 120,k + 260,str$(large_strait) : p1(5,14) = large_strait
  endif
else
  ink red,0
  a$ = str$(p1(turn,14)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 260,a$
  if p1(turn,14) <> -1 then bscoar = bscoar + p1(turn,14)
endif
text s,k + 260,"large straight:"
if p1(turn,15) = 0
  ink blue,0
  if iyahtzee = 1
    text s,k + 280,"50" : p1(5,15) = 50
  else
    text s + 120,k + 280,str$(iyahtzee) : p1(5,15) = iyahtzee
  endif
else
  ink red,0
  a$ = str$(p1(turn,15)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 280,a$
  if p1(turn,15) <> -1 then bscoar = bscoar + p1(turn,15)
endif
text s,k + 280,"iyahtzou:"
if p1(turn,16) = 0
  ink blue,0
  text s + 120,k + 300,str$(chance) : p1(5,16) = chance
else
  ink red,0
  a$ = str$(p1(turn,16)) : if a$ = "-1" then a$ = "0"
  text s + 120,k + 300,a$
  if p1(turn,16) <> -1 then bscoar = bscoar + p1(turn,16)
endif
text s,k + 300,"Chance:"
ink purple,0
text s,k + 320,"Sub-Total:"
text s + 120,k + 320,str$(bscoar)
text s,k + 340,"Grand Total:"
text s + 120,k + 340,str$(scoar + bscoar)
score(turn) = scoar + bscoar
sync
return



DP_ROLL:
`cls rgb(0,150,30)
`ink rgb(255,255,255),0
`ink rgb(0,35,182),0
`box 0,420,639,479
for i=1 to 5
 if num_spins(turn) > 0 and change(i) = 0 then paste image dice(i),((i-1)*70)+50,20
next i
for i=1 to 5
 if num_spins(turn) = 0 or change(i) = 1
  for spin = 1 to (rnd(17) + 5)
  paste image rnd(5) + 1,((i - 1) * 70) + 50,20
  ` print dice(i)
  sync
`  wait 5
  next spin
  wait 5
 endif
paste image dice(i),((i - 1) * 70) + 50,20
next i
sync
return

MAKE_IMGS:

create bitmap 1,60,60
restore IMG_DATA
for img = 1 to 6
  cls
  ink blue,0
  box 0,0,60,60
  ink white,0
  box 2,2,58,58
  read NumberOfDots
  ink red,0
  for NOD = 1 to NumberOfDots
    read x,y
    box x,y,x + 6,y + 2
    box x + 1,y - 1,x + 5,y + 3
    box x + 2,y -2,x + 4,y + 4
  next NOD
 get image img,0,0,60,60
next img
set current bitmap 0
delete bitmap 1
sync



return

IMG_DATA:
rem one  NumberOfDots,x1,y1,x2,y2 per dot
data 1,28,28
rem two
data 2,28,14,28,42
rem three
data 3,28,14,28,28,28,42
rem four
data 4,14,14,42,14,14,42,42,42
rem five
data 5,14,14,42,14,28,28,14,42,42,42
rem six
data 6,14,14,14,28,14,42,42,14,42,28,42,42


RE_ROLL_DICE:
 cls green
 ink blue,0
 box 0,420,SW - 1,SH - 1
for i = 1 to 5
 if change(i) > 0 then dice(i) = rnd(5) + 1
next i
gosub EVAL_ROLL
return

ROLL_DICE:
for i = 1 to 5
 dice(i) = rnd(5) + 1
next i
gosub EVAL_ROLL
return

EVAL_ROLL:
` determine what player has got
` init vars
iyahtzee=0 : large_strait=0 : small_strait=0 : full_house=0
four_of_a_kind=0 : three_of_a_kind=0: sixes=0 : fives=0 : fours=0: threes=0
twos=0 : onesies=0
rem store data
for i=1 to 6 : okay(i)=0 : next i
for t=1 to 6
 for i=1 to 5
  if dice(i)=t then okay(t)=okay(t)+1
 next i
next t
rem iyahtzee
t=dice(1):ct=0
for i=1 to 6
 if okay(i)=5 then ct=i
next i
if ct>0 then iyahtzee=1
rem small & large strait
ct=0
for i=1 to 5
 if okay(i)=0 then ct=-1
next i
if ct=0 then large_strait=1 : small_strait=1
ct=0
for i=2 to 6
 if okay(i)=0 then ct=-1
next i
if ct=0 then large_strait=1 : small_strait=1
ct=0
for i=1 to 4
 if okay(i)=0 then ct=-1
next i
if ct=0 then small_strait=1
ct=0
for i=2 to 5
 if okay(i)=0 then ct=-1
next i
if ct=0 then small_strait=1
ct=0
for i=3 to 6
 if okay(i)=0 then ct=-1
next i
if ct=0 then small_strait=1
rem full house
nbr1=0 : nbr2=0
for t=1 to 6
 if okay(t)>=3 then nbr1=t
 if okay(t)>=2 and t<>nbr1 then nbr2=t
next t
if nbr1>0 and nbr2>0 then full_house=1
rem four of a kind
ct=0 : dt=0
for i=1 to 6
 if okay(i)>=4 then ct=1
 if okay(i)>=3 then dt=1
next i
if ct=1 then four_of_a_kind=1 : three_of_a_kind=1
if dt=1 then three_of_a_kind=1
return

TITLE_SCREEN:
cls : okay = 0 : counter = 0 : CTimer# = timer() + 80
repeat
  if timer() > CTimer# then inc counter : CTimer# = timer() + 80 : if counter > 5 then counter = 1
  ink colr(counter),0
  box 0,0,SW,SH
  ink colr(counter + 1),0
  box 4,4,SW - 4,SH - 4
  ink colr(counter + 2),0
  box 8,8,SW - 8,SH - 8
  ink colr(counter + 3),0
  box 12,12,SW - 12,SH - 12
  ink rgb(0,0,0),0
  box 16,16,SW - 16,SH - 16
  s = SW * .5 : h = SH * .4 : a$ = "Iyahtzou"
  set text size 50
  ink blue,0 : center text s + 6, h - 6,a$
  ink purple,0 : center text s + 8, h - 8,a$
  ink white,0 : center text s + 10, h - 10,a$
  ink red,0 : center text s + 12, h - 12,a$
  set text size 14
  h = SH * .55 : a$ = "by LBFN"
  ink red,0 : center text s + 1, h - 1,a$
  ink blue,0 : center text s + 2, h - 2,a$
  ink green,0 : center text s + 3, h - 3,a$
  ink purple,0 : center text s + 4, h - 4,a$
  ink colr(counter),0
  ttd$ = "Press 2, 3 or 4 to select # of players"
  tw = text width(ttd$) * .5
  center text (SW * .5),SH * .8 ,ttd$
  scan = scancode()
  if scan >= 2 and scan <= 5 then NumPlayers = scan - 1 : okay = 1
  sync
until okay = 1
cls
` wait until the user is not pressing a key
repeat
  sync
until scancode() = 0
ink white,0
for n = 1 to NumPlayers
  name$(n)=""
  set cursor 100,100 + n * 20
  input "Enter the name for player " + str$(n) + " : ";name$
  Name$(n) = name$
next n
`if NumPLayers = 1 then name$(2) = "Computah"
return

CPU_TURN:
cls
text 100,100,"It's the computah's turn."
sync
wait 1000
end

return

DeclareWinner:
` display everyone's scores
cls green
ink blue,0
box 0,420,SW - 1,SH - 1
for turn = 1 to NumPlayers
  s = ((turn - 1) * 180) + 5
  ink yellow,0
  set text size 11
  text s + 20,380,name$(turn)
  gosub  PRINT_STATUS
next turn
` calculate the scores
winner = 0
if score(1) > score(2) and score(1) > score(3) and score(1) > score(4) then winner = 1
if score(2) > score(1) and score(2) > score(3) and score(2) > score(4) then winner = 2
if NumPLayers >= 3
  if score(3) > score(1) and score(3) > score(2) and score(3) > score(4) then winner = 3
endif
if NumPLayers = 4
  if score(4) > score(1) and score(4) > score(2) and score(4) > score(3) then winner = 4
endif
repeat
  mc = mouseclick()
  sync
until mc = 0
ink white,0
if winner = 0
  ` wait until the user lets go of the mouse button
  repeat
    center text SW * .5,SH - 150,"It's a tie!!!"
    center text SW * .5,SH - 130,"Click mouse to quit."
    sync
  until mouseclick() > 0
else
  repeat
    mc = mouseclick()
    center text SW * .5,SH- 150,name$(winner) + " is the winner!"
    center text SW * .5,SH -130,"Click mouse to quit."
    sync
  until mc > 0
endif
return