lodchjo
Number of posts : 10 Registration date : 2012-01-30
| Subject: Samegame clone Fri May 25, 2012 3:20 pm | |
| Here's my version of the Morisuke's Samegame: It shows Panoramic is a powerful programming language and games don't require thousands of code to work. Enjoy it! Lode - Code:
-
application_title "SameGame" label sg, dmn, init, nxt, drw, strt, mm, rst, hlp, xt width 0,650:height 0,620:color 0,255,255,255:caption 0,"SameGame" dim m,n,x,y,z, a(21,26), item, sk, k, b(1000),c(1000), a$, d(25), bl, lv, klr, klg, klb, kly, klp, kll, kln, klc, klw main_menu 2000 sub_menu 2001:parent 2001,2000:caption 2001,"New game":on_click 2001, rst sub_menu 2002:parent 2002,2000:caption 2002,"Next level":on_click 2002, nxt sub_menu 2003:parent 2003,2000:caption 2003,"Help":on_click 2003, hlp sub_menu 2004:parent 2004,2000:caption 2004,"Exit":on_click 2004, xt form 2010:width 2010, 650:height 2010, 620:caption 2010,"SameGame":color 2010,0,255,0 memo 2011:parent 2011, 2010:left 2011, 5: top 2011, 5:width 2011, 630:height 2011, 495:font_name 2011, "Comic Sans MS": font_size 2011, 12:on_click 2011, mm alpha 2012:parent 2012, 2010:left 2012, 5: top 2012, 505:width 2012, 300:height 2012, 25: font_size 2012, 12: caption 2012, "ENTER YOUR NAME HERE (12 characters max.):" color 2012, 0,255,0:font_color 2012, 255,255,255:font_bold 2012 edit 2013:parent 2013, 2010:left 2013, 410: top 2013, 505:width 2013, 225:height 2013, 25: font_size 2013, 12 button 2014:parent 2014, 2010:left 2014, 5: top 2014, 540:width 2014, 630:height 2014, 40: caption 2014, "INITIALISING . . . PLEASE WAIT": on_click 2014, strt inactive 2014 set_focus 2013 container 2019:top 2019,16:left 2019, 460:width 2019,165: height 2019, 170 alpha 2020:parent 2020, 2019:left 2020,10:top 2020, 20:caption 2020, "Player:":font_bold 2020 alpha 2021:parent 2021, 2019:left 2021,10:top 2021, 50:caption 2021, "Skore:":font_bold 2021 alpha 2022:parent 2022, 2019:left 2022,10:top 2022, 80:caption 2022, "Level:":font_bold 2022 alpha 2023:parent 2023, 2019:left 2023,10:top 2023,110:caption 2023, "Bonus:":font_bold 2023 alpha 2024:parent 2024, 2019:left 2024,10:top 2024,140:caption 2024, "Blocks left:":font_bold 2024 container 2025:top 2025,200:left 2025, 460:width 2025,165 alpha 2026:parent 2026, 2025:left 2026,10:top 2026, 20:font_bold 2026:font_color 2026,255,0,0: rem red alpha 2027:parent 2027, 2025:left 2027,10:top 2027, 50:font_bold 2027:font_color 2027,0,255,0:rem green alpha 2028:parent 2028, 2025:left 2028,10:top 2028, 80:font_bold 2028:font_color 2028,0,0,255:rem blue alpha 2029:parent 2029, 2025:left 2029,10:top 2029, 110:font_bold 2029:font_color 2029,255,255,0:rem yellow alpha 2030:parent 2030, 2025:left 2030,10:top 2030, 140:font_bold 2030:font_color 2030,255,0,255:rem pink alpha 2031:parent 2031, 2025:left 2031,10:top 2031, 170:font_bold 2031:font_color 2031,0,255,255:rem light blue alpha 2032:parent 2032, 2025:left 2032,10:top 2032, 200:font_bold 2032:font_color 2032,200,100,0:rem brown alpha 2033:parent 2033, 2025:left 2033,10:top 2033, 230:font_bold 2033:font_color 2033,0,0,0:rem black alpha 2034:parent 2034, 2025:left 2034,10:top 2034, 260:font_bold 2034:color 2034,0,0,0:font_color 2034,255,255,255:rem white item_add 2011, " " item_add 2011, string$(26," ")+"Instructions:" item_add 2011, string$(25," ")+"---------------" item_add 2011, " " item_add 2011, " - The goal of the game is to clear the game field." item_add 2011, " - To remove blocks, click on a block." item_add 2011, " - Adjoining blocks of the same color will also be removed." item_add 2011, " - Think strategically to remove as many blocks as possible." item_add 2011, " - The more blocks removed with 1 click, the higher the bonus!" item_add 2011, " - Single blocks cannot be removed. The minimum number of blocks is 2." item_add 2011, " - When all blocks have been removed, you go to the next level." item_add 2011, " - If you cannot remove all blocks, you can still go to the next level," item_add 2011, " but you will lose 100 points for each block left over." item_add 2011, " (Press 'next level' in the menu.)" item_add 2011, " - If you succesfully removed all blocks, you get a 1.000 bonus!" item_add 2011, " - Each next level adds an extra color." item_add 2011, " - The game is over when you lose too many points and get a negative score." item_add 2011, " " item_add 2011, string$(25," ")+"Programmed by Lodchjo © 2012 using Panoramic Language." item_add 2011, string$(25," ")+"(Original game by Kuniaki Moribe (Morisuke), 1985.)" for y = 1 to 25 for x = 1 to 20 picture x+y*25 left x+y*25, x*21:height x+y*25, 20: width x+y*25, 20: top x+y*25,y*21:on_click x+y*25,sg next x next y caption 2014, "START GAME":active 2014 lv=1 sk=0 gosub init end init: bl=500 m=0 klr=0:klg=0:klb=0:kly=0:kll=0:kln=0:klc=0:klw=0:klp=0 caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(m*(m-1)):caption 2024,"Blocks left: "+str$(bl) for y = 1 to 25 for x = 1 to 20 a(x,y)= int(rnd(lv+2)+1) gosub drw show x+y*25 next x next y caption 2026, str$(int(klr/(lv+4))) + "% red blocks" caption 2027, str$(int(klg/(lv+4))) + "% green blocks" caption 2028, str$(int(klb/(lv+4))) + "% blue blocks" if kly>0 then caption 2029, str$(int(kly/(lv+4))) + "% yellow blocks" if klp>0 then caption 2030, str$(int(klp/(lv+4))) + "% pink blocks" if kll>0 then caption 2031, str$(int(kll/(lv+4))) + "% light blue" if kln>0 then caption 2032, str$(int(kln/(lv+4))) + "% brown" if klc>0 then caption 2033, str$(int(klc/(lv+4))) + "% black" if klw>0 then caption 2034, str$(int(klw/(lv+4))) + "% white" height 2025, 80+lv*30 return sg: item = number_click if number_change>0 then item = number_change if item>0 x=mod(item,25) y=(item-x)/25 k=a(x,y) if a(x-1,y)<>k and a(x+1,y)<>k and a(x,y+1)<>k and a(x,y-1)<>k then return hide item:sk=sk+1:bl=bl-1 caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(m*(m-1)):caption 2024,"Blocks left: "+str$(bl) a(x,y)=0 b(1)=x:c(1)=y end_if if k<>0 then gosub dmn return dmn: n=1 m=0 repeat n=n-1 if x>1 and a(x-1,y)=k then n=n+1:m=m+1:b(n)=x-1:c(n)=y:sk=sk+1:bl=bl-1 if x<20 and a(x+1,y)=k then n=n+1:m=m+1:b(n)=x+1:c(n)=y:sk=sk+1:bl=bl-1 if y>1 and a(x,y-1)=k then n=n+1:m=m+1:b(n)=x:c(n)=y-1:sk=sk+1:bl=bl-1 if y<25 and a(x,y+1)=k then n=n+1:m=m+1:b(n)=x:c(n)=y+1:sk=sk+1:bl=bl-1 for z=1 to n hide b(z)+c(z)*25:a(b(z),c(z))=0 next z x=b(n):y=c(n) until n=0 sk=sk+m*(m-1) caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(m*(m-1)):caption 2024,"Blocks left: "+str$(bl) wait 50 if bl=0 then message "Congratulations!! Perfect game!":goto nxt rem -------------------------- fl=falling blocks for x = 1 to 20 for y = 0 to 24 if a(x,y)<>0 and a(x,y+1)=0 then a(x,y+1)=a(x,y):a(x,y)=0:show (x+(y+1)*25):hide (x+y*25):y=0 next y for y = 1 to 25 gosub drw next y next x rem ---------------------------- check for empty columns z=0 c(1)=0 for x = 1 to 20 d(x)=0 for y=1 to 25 d(x)=d(x)+a(x,y) next y next x rem ------------------------------ move columns for x = 1 to 19 if d(x+1)<>0 and d(x)=0 d(x)=d(x+1):d(x+1)=0 for y = 1 to 25 a(x,y)=a(x+1,y):a(x+1,y)=0:hide (x+1+y*25) gosub drw next y x=1 end_if next x return nxt: if bl>0 then sk = sk-bl*100:message "You lose "+str$(bl*100)+" points!" if bl=0 then sk = sk+1000:message "You win 1000 extra points!" caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(bl*100):caption 2024,"Blocks left: "+str$(bl) if sk <0 then message "Game Over":lv=0:sk=0: show 2014 lv=lv+1:if lv>8 then lv=1 goto init return drw: select a(x,y) case 0 hide x+y*25 case 1 color x+y*25, 255,0,0:show x+y*25 if bl=500 then klr=klr+1 case 2 color x+y*25, 0,255,0:show x+y*25 if bl=500 then klg=klg+1 case 3 color x+y*25, 0,0,255:show x+y*25 if bl=500 then klb=klb+1 case 4 color x+y*25, 255,255,0:show x+y*25 if bl=500 then kly=kly+1 case 5 color x+y*25, 255,0,255:show x+y*25 if bl=500 then klp=klp+1 case 6 color x+y*25, 0,255,255:show x+y*25 if bl=500 then kll=kll+1 case 7 color x+y*25, 200,100,0:show x+y*25 if bl=500 then kln=kln+1 case 8 color x+y*25, 0,0,0:show x+y*25 if bl=500 then klc=klc+1 case 9 color x+y*25, 255,255,255:show x+y*25 if bl=500 then klw=klw+1 end_select return strt: caption 2020, "Player: "+left$(text$(2013),12) hide 2010 return mm: set_focus 2013 return rst: show 2010 sk=0 caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(m*(m-1)):caption 2024,"Blocks left: "+str$(bl) gosub init return hlp: show 2010 return xt: terminate
| |
|