Ghostwriters

[stef]

Hi

This democode is just the precursordemo of "Ghostwriters".

I call it "BOO" :) (It is really scary)

"Ghostwriter" itself is a puzzle-game. Had some problems with the code, but I hope I can finished it until Halloween.

Code Select Expand


; PROJECT : BOO
; AUTHOR  : stef
; CREATED : 18.10.2006
; EDITED  : 20.10.2006
; ---------------------------------------------------------------------

; made with PB 1.50
; just watch

global message$="BOO" ;you can change this string, maximum 3 characters (to see)

OpenScreen 800,600,32,2
setfps 60

Global Font2=GetFreeFont()
LoadFont "arial",Font2,400,0

Type tstars
xtext#,ytext#
x#,y#
dx#,dy#
angle#
exist
delaytime
delay
EndType
Global maxstars=200
Dim stars(maxstars) As tstars

Global preghost,counter
Global textimage=NewImage(800,400)
Global textimage2=NewImage(800,400)
Global scale#=4.0

imagedraw()
initghosts()

tim#=Timer()/1000.0
Ink RGB(255,255,255)

ghost=NewFXImage(300,300)

Do
sec#=(Timer()/1000.0-tim#)

CopyImage preghost,ghost

RenderToScreen
Cls 70

If sec#>6
scale#=scale#+0.005
one=1
endif

ScaleImage ghost,scale#,scale#*2.0,1
If scale#>18 Then scale#=17

For x = 0 To maxstars
If stars(x).delay> 0 And stars(x).exist=1
DrawImage ghost,stars(x).x#,stars(x).y#+Rnd(one),1
   EndIf
  stars(x).delay=stars(x).delay-1
  If stars(x).delay < -2
stars(x).delay=stars(x).delaytime
EndIf
Next

Sync

If sec#>6 Then updateghosts()

Loop

Function imagedraw()

preghost=NewImage(300,300)
RenderToImage preghost
RenderPhongImage preghost,150,250,RGB(250,255,255),450,2.5
CircleC 100,160,16,1,RGB(20,20,20)
CircleC 200,160,16,1,RGB(20,20,20)
EllipseC 150,200,50,10,1,RGB(20,20,20)

For x= 0 To 300 Step 60
CircleC x,300,30,1,RGB(0,0,0)
Next

RenderToImage textimage

SetFont Font2
Ink 255
CenterText 400,0,message$

For y= 1 To 400 Step 20
For x= 1 To 800 Step 20
RenderToImage textimage
col=Point(x,y)
RenderToImage textimage2
If col= RGB(0,0,255)
stars(counter).exist=1
stars(counter).xtext#=x
stars(counter).ytext#=y
counter=counter+1
EndIf
Next
Next

EndFunction

Function updateghosts()
For x = 0 To maxstars
If Abs(stars(x).y#-stars(x).ytext#)>0.1 Or Abs(stars(x).x#-stars(x).xtext#)>0.1
stars(x).x#=stars(x).x#+stars(x).dx#*0.2
stars(x).y#=stars(x).y#+stars(x).dy#*0.2
EndIf
Next
EndFunction


Function initghosts()
For x = 0 To maxstars
stars(x).x#=RndRange(10,790)
stars(x).y#=RndRange(10,590)
stars(x).delaytime=RndRange(200,400)
stars(x).delay=RndRange(20,400)

stars(x).angle#=GetAngle2D(stars(x).x#,stars(x).y#,stars(x).xtext#,stars(x).ytext#)
stars(x).dx#=Cos(stars(x).angle#)
stars(x).dy#=Sin(stars(x).angle#)
Next
EndFunction





[Ian Price]

That's a nice little demo :)

[stef]

Hi Ian!

This is the 'Ghostwriters'-Code.

It's a little Halloween-Joke :)

Had a lot of ideas to this theme, but of certain reasons I realized this.
It based on my code 'Jigsaw-Puzzler' (in folder sourcecodes)

Mission: 8)
The ghosts are captured in a 'encrypted phatom zone' and display messages.
Decode it for releasing the ghosts.


Bring the tiles to correct arrangment.(It's not easy)
To make it easier change
Global tilesizex=100
Global tilesizey=100
to
Global tilesizex=200
Global tilesizey=200



Click a tile (blue frame), click another tile to exchange

F1 for (code related info)

F3 or spacekey for 'cheating' :)


made with PB 1.54

Code Select Expand


; PROJECT : Ghostwriters
; AUTHOR  : stef
; CREATED : 26.10.2006
; EDITED  : 28.10.2006



Global screenw=800
Global screenh=600
Global tilesizex=100
Global tilesizey=100
Global imagesizex=600
Global imagesizey=400
Global tilesx=imagesizex/tilesizex
Global tilesy=imagesizey/tilesizey
Global tiles=tilesx*tilesy
Global offsetx=(screenw-imagesizex)/2
Global offsety=(screenh-imagesizey)/2


OpenScreen screenw,screenh,16,2
Global fpsset=60
SetFPS fpsset

Global Font2=GetFreeFont()
LoadFont "arial",Font2,300,0

Global Font3=GetFreeFont()
LoadFont "arial",Font3,30,1


Global ghostcount
Global status=0
Global solved=0

Global fs=20;framebreadthfs=20;framebreadth
col=RGB(100,100,100)
colorframe_im=NewImage(screenw,screenh)
RenderToImage colorframe_im
;boxc 0,0,screenw,screenh,1,rgb(0,0,100)
BoxC offsetx-fs,offsety-fs,offsetx+imagesizex+fs,offsety+imagesizey+fs,1,col
BoxC offsetx,offsety,offsetx+imagesizex,offsety+imagesizey,1,RGB(0,0,0)

Global display=1
Global bluebox=0
Global grid=-1
Global choice=1
Global info=1
Global tim
Global time1#=Timer()
Global time2#=Timer()
Global delay2
Global messagetime=25000;ms

Global xmouse
Global ymouse


Global display_im

Type tparts
image
xnumber
ynumber
xactualpos
yactualpos
xcorrectpos
ycorrectpos
xfalsepos
yfalsepos

correctposexist
falseposexist
EndType


Dim parts(tiles) As tparts

For a = 1 To tiles
parts(a).image=NewImage(tilesizex,tilesizey)
parts(a).xnumber=xval
parts(a).ynumber=yval
parts(a).xcorrectpos=parts(a).xnumber*tilesizex
parts(a).ycorrectpos=parts(a).ynumber*tilesizey

xval=xval+1
If xval=tilesx
xval=0
yval=yval+1
EndIf
If yval=tilesy Then yval=0
Next

;setting tiles on randompositions
For a = 1 To tiles
Repeat
anew = RndRange(1,tiles)
If parts(a).correctposexist=0 And parts(anew).falseposexist=0
parts(anew).falseposexist=1
parts(a).correctposexist=1
parts(a).xfalsepos=parts(anew).xcorrectpos
parts(a).yfalsepos=parts(anew).ycorrectpos
Inc newexistcounter
If newexistcounter=tiles Then ExitRepeat
EndIf
Until parts(anew).falseposexist=0
Next


Do

generateimage()

RenderToImage display_im
For a= 1 To tiles
GetImage parts(a).image,parts(a).xcorrectpos,parts(a).ycorrectpos,parts(a).xcorrectpos+tilesizex,parts(a).ycorrectpos+tilesizey
Next

RenderToScreen
Cls 70

If status < 2 Then DrawImage colorframe_im,0,0,1

For a= 1 To tiles
If bluebox=1
If parts(a).xactualpos=bluex And parts(a).yactualpos=bluey
old=a
EndIf
EndIf

If display=1;falsepos
parts(a).xactualpos=parts(a).xfalsepos
parts(a).yactualpos=parts(a).yfalsepos
Else
parts(a).xactualpos=parts(a).xcorrectpos
parts(a).yactualpos=parts(a).ycorrectpos
EndIf
If yellowbox=1
If parts(a).xactualpos=yellowx And parts(a).yactualpos=yellowy
yellowbox=0
parts(a).xfalsepos=parts(old).xfalsepos
parts(a).yfalsepos=parts(old).yfalsepos
parts(old).xfalsepos=yellowx
parts(old).yfalsepos=yellowy
EndIf
EndIf

DrawImage parts(a).image,parts(a).xactualpos+offsetx,parts(a).yactualpos+offsety,1

Next

xmouse=MouseX()
ymouse=MouseY()


If grid=-1
For x = 0 To imagesizex Step tilesizex
LineC x+offsetx,0+offsety,x+offsetx,imagesizey+offsety,RGB(255,0,0)
Next
For x = 0 To imagesizey Step tilesizey
LineC 0+offsetx,x+offsety,imagesizex+offsetx,x+offsety,RGB(255,0,0)
Next
EndIf

CircleC xmouse,ymouse,5,1,RGB(255,0,0)

If status <6

If display=1;color boxes (green,blue,yellow)
For y=0 To imagesizey-tilesizey Step tilesizey
For x = 0 To imagesizex- tilesizex Step tilesizex
If PointInBox(xmouse,ymouse,x+offsetx,y+offsety,x+tilesizex+offsetx,y+tilesizey+offsety)
BoxC x+offsetx,y+offsety,x+tilesizex+1+offsetx,y+tilesizey+offsety,0,RGB(0,255,0)
If LeftMouseButton()=1
FlushMouse
If bluebox=0
bluebox=1
yellowbox=0
bluex=x
bluey=y
ElseIf bluebox=1
bluebox=0
yellowbox=1
yellowx=x
yellowy=y
EndIf
EndIf
EndIf
Next
Next
EndIf

If bluebox=1
BoxC bluex+offsetx,bluey+offsety,bluex+tilesizex+1+offsetx,bluey+tilesizey+offsety,0,RGB(0,0,255)
EndIf
If yellowbox=1
BoxC yellowx+offsetx,yellowy+offsety,yellowx+tilesizex+1+offsetx,yellowy+tilesizey+offsety,0,RGB(255,255,0)
EndIf

EndIf

checkkeys()

;check for solution;-------------------------------------------------------

For a = 1 To tiles
If parts(a).yfalsepos<>parts(a).ycorrectpos Or parts(a).xfalsepos<>parts(a).xcorrectpos
solved=0
ExitFor
Else solved=1
EndIf

Next

If solved=1
grid=1
status=6
text$="CONGRATULATION  YOU MADE IT"
Else
text$="RELEASE GHOSTS"
blink=0
EndIf

;------------------------------------------------------------------------------
Ink RGB(255,255,0)
SetFont font3
If blink< 20

CenterText screenw/2,offsety+imagesizey+fs,  text$
EndIf
Inc blink
If blink>30 Then blink=0
CenterText screenw/2,offsety-60,"GHOSTWRITERS"
Sync
DeleteImage display_im
Loop


Function checkkeys()
If FunctionKeys(1)=1
FlushKeys
info=info*-1
EndIf

If info=-1
SetFont 1
Ink RGB(255,255,255)
Print "F1:toggles info, F2:red grid, F3:tiles in correct position"
Print "FPS set to: "+Str$(fpsset)
Print "tiles: "+Str$(tiles)
Print "Imagesize: "+ Str$(imagesizex)+"*"+Str$(imagesizey)
Print "Tilesize: "+ Str$(tilesizex)+"*"+Str$(tilesizey)
Print "mouse-x: "+Str$(xmouse)
Print "mouse-y: "+Str$(ymouse)
EndIf

If FunctionKeys(2)=1
FlushKeys
grid=grid*-1
EndIf
If FunctionKeys(3)=1  or spacekey()=1
FlushKeys
display=display*-1

EndIf


EndFunction


Function generateimage()

Static scale#
Static one=1
Static numbmessage=4
Static newmess

If status=0
status=1

Type tghost
xtext#,ytext#
oldx#,oldy#
x#,y#
dx#,dy#
angle#
exist
exist2
delaytime
delay
EndType

Static maxghost=120
Dim ghost(maxghost) As tghost

For x = 0 To maxghost
ghost(x).x#=RndRange(10,imagesizex-10)
ghost(x).y#=RndRange(10,imagesizey-10)
ghost(x).delaytime=RndRange(200,400)
ghost(x).delay=RndRange(20,400)

Next


Static preghost,counter
scale#=4.0
SetFont Font2
Ink 255

Dim textimage(numbmessage)

For a = 0 To numbmessage

If a= 0 Then message$="HLP":hei=-40
If a= 1 Then message$="CQD":hei=0
If a= 2 Then message$="SOS":hei=50
If a= 3 Then message$="THX":hei=100
If a= 4 Then message$="BYE":hei=40


textimage(a)=NewImage(imagesizex,imagesizey)
RenderToImage textimage(a)
CenterText imagesizex/2,hei,message$
Next

preghost=NewImage(300,300)
RenderToImage preghost
RenderPhongImage preghost,150,250,RGB(250,255,255),450,2.5
CircleC 100,160,16,1,RGB(20,20,20)
CircleC 200,160,16,1,RGB(20,20,20)
EllipseC 150,200,50,10,1,RGB(20,20,20)

For x= 0 To 300 Step 60
CircleC x,300,30,1,RGB(0,0,0)
Next
EndIf
;----------------------------------------------------------status
If Timer()-time1#>messagetime
time1#=Timer()
If status<6 Then status =1
Inc newmess
If newmess>3 Then newmess=0
EndIf


If status >0 And status<8
If status = 6
newmess=4
status=7
EndIf
If status <3
status=-1
EndIf

counter=0
RenderToImage textimage(newmess)
For y= 1 To imagesizey Step 20
For x= 1 To imagesizex Step 20

col=Point(x,y)
If col>0
ghost(counter).exist=1
ghost(counter).xtext#=x
ghost(counter).ytext#=y
counter=counter+1
EndIf
Next
Next
ghostcount=counter

For ind =0 To maxghost
If ghost(ind).exist=0
ghost(ind).exist=2
ghost(ind).xtext#=RndRange(1,imagesizex)
If ghost(ind).xtext#<imagesizex/2
ghost(ind).xtext#=10
Else
ghost(ind).xtext#=imagesizex-20
EndIf

ghost(ind).ytext#=RndRange(1,imagesizey)
If ghost(ind).ytext#<imagesizey/2
ghost(ind).ytext#=10
Else
ghost(ind).ytext#=imagesizey-40
EndIf


EndIf
Next

If status<8
For x = 0 To maxghost


ghost(x).angle#=GetAngle2D(ghost(x).x#,ghost(x).y#,ghost(x).xtext#,ghost(x).ytext#)
ghost(x).dx#=Cos(ghost(x).angle#)
ghost(x).dy#=Sin(ghost(x).angle#)
Next
EndIf

EndIf
;-----------------------------------------------------------------------------

If status=7

Inc delay2
If delay2>700
status=8
For x = 0 To maxghost

ang1#=Rnd(360)
ghost(x).xtext#=-SinNewValue(imagesizex/2,ang1#,2000)
ghost(x).ytext#=-CosNewValue(imagesizey/2,ang1#,2000)
ghost(x).angle#=GetAngle2D(ghost(x).x#,ghost(x).y#,ghost(x).xtext#,ghost(x).ytext#)
ghost(x).dx#=Cos(ghost(x).angle#)
ghost(x).dy#=Sin(ghost(x).angle#)

Next
EndIf

EndIf

ghost=NewFXImage(300,300)
CopyImage preghost,ghost

scale#=scale#+0.02
ScaleImage ghost,scale#,scale#*2.0,1

If scale#>18 Then scale#=17

display_im=NewImage(imagesizex,imagesizey)

RenderToImage display_im

For x = 0 To maxghost
If ghost(x).delay> 0
DrawImage ghost,ghost(x).x#,ghost(x).y#+Rnd(one)-5,1
   EndIf
  ghost(x).delay=ghost(x).delay-1
  If ghost(x).delay < -2
ghost(x).delay=ghost(x).delaytime
EndIf
Next

If Timer()-time2#>5000
For x = 0 To maxghost
If Abs(ghost(x).y#-ghost(x).ytext#)>1 Or Abs(ghost(x).x#-ghost(x).xtext#)>1
ghost(x).x#=ghost(x).x#+ghost(x).dx#
ghost(x).y#=ghost(x).y#+ghost(x).dy#
EndIf
ghost(x).exist=0
Next
EndIf
DeleteImage ghost

EndFunction





[stef]

Hm?! Seems it wasn't that success.
However. I liked it.

Well...

[Ian Price]

Sorry Stef - I missed this first time. It's cool :)