Hi all,
Thanks to Leo for fixing up the struct PMCs, I've code that can create a
new SDL window and blit a blue rectangle onto it. Animation's not far
off now!
There are a couple of bugs, however. First, I had to add some C-type
conversion code to classes/unmanagedstruct.pmc. It's almost certainly
wrong, but without it, I wouldn't have gone as far. This may be related
to why it requires r 255, g 0, b 255 to draw a blue rectangle.
I'm not sure UnManagedStruct understands UINT8.
Second, my PIR is undoubtedly funky. Still, the results speak for
themselves.
I've attached my patch to classes/unmanagedstruct.pmc and
src/call_list.txt as well as the library files and my demo PIR.
Enhancements and bug fixes welcome.
Be sure to run this in a directory containing "datatypes.pasm" or else
fix it to find the copy with Parrot (I tried).
-- c
Index: classes/unmanagedstruct.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/unmanagedstruct.pmc,v
retrieving revision 1.24
diff -u -u -r1.24 unmanagedstruct.pmc
--- classes/unmanagedstruct.pmc 27 Jan 2004 11:32:48 -0000 1.24
+++ classes/unmanagedstruct.pmc 31 Jan 2004 08:22:13 -0000
@@ -87,6 +87,7 @@
case enum_type_INTVAL:
case enum_type_int:
return *(INTVAL*) p;
+ case enum_type_uint8:
case enum_type_int16:
case enum_type_uint16:
case enum_type_short:
@@ -95,7 +96,7 @@
case enum_type_uchar:
return *p;
default:
- internal_exception(1, "unhandled type in struct");
+ internal_exception(1, "returning unhandled int type in struct");
}
return -1;
}
@@ -111,7 +112,7 @@
case enum_type_double:
return (FLOATVAL) *(double*) p;
default:
- internal_exception(1, "unhandled type in struct");
+ internal_exception(1, "returning unhandled float type in struct");
}
return -1.0;
}
@@ -130,13 +131,14 @@
case enum_type_int:
*(int*) p = value;
break;
+ case enum_type_uint8:
case enum_type_int16:
case enum_type_uint16:
case enum_type_short:
*(short*)p = (short)value;
break;
default:
- internal_exception(1, "unhandled type in struct");
+ internal_exception(1, "setting unhandled int type in struct");
break;
}
}
Index: src/call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.27
diff -u -u -r1.27 call_list.txt
--- src/call_list.txt 2 Jan 2004 21:20:43 -0000 1.27
+++ src/call_list.txt 31 Jan 2004 08:22:14 -0000
@@ -205,3 +205,6 @@
i pPtiiipi
i tpiibi
+# Used by library/sdl.imc
+p iiil
+i ppl
--- /dev/null 1969-12-31 16:00:00.000000000 -0800
+++ library/sdl.pasm 2004-01-31 00:08:45.000000000 -0800
@@ -0,0 +1,13 @@
+savetop
+loadlib P1, 'libSDL.so'
+dlfunc P2, P1, 'SDL_Init', 'ii'
+store_global 'SDL::SDL_Init', P2
+dlfunc P2, P1, 'SDL_SetVideoMode', 'piiil'
+store_global 'SDL::SDL_SetVideoMode', P2
+dlfunc P2, P1, 'SDL_Quit', 'v'
+store_global 'SDL::SDL_Quit', P2
+dlfunc P2, P1, 'SDL_FillRect', 'ippl'
+store_global 'SDL::SDL_FillRect', P2
+dlfunc P2, P1, 'SDL_UpdateRect', 'vpiiii'
+store_global 'SDL::SDL_UpdateRect', P2
+restoreall
--- /dev/null 1969-12-31 16:00:00.000000000 -0800
+++ library/sdl_types.imc 2004-01-31 00:14:16.000000000 -0800
@@ -0,0 +1,95 @@
+.include "datatypes.pasm"
+
+.pcc_sub _init_SDL_types prototyped
+ newsub $P0, .Sub, new_SDL_Rect
+ store_global 'new_SDL_Rect', $P0
+ print "Init types\n"
+ .pcc_begin_return
+ .pcc_end_return
+.end
+
+.pcc_sub _new_SDL_Rect prototyped
+ new $P2, .OrderedHash
+ set $P2['x'], .DATATYPE_INT16
+ push $P2, 0
+ push $P2, 0
+ set $P2['y'], .DATATYPE_INT16
+ push $P2, 0
+ push $P2, 0
+ set $P2['w'], .DATATYPE_UINT16
+ push $P2, 0
+ push $P2, 0
+ set $P2['h'], .DATATYPE_UINT16
+ push $P2, 0
+ push $P2, 0
+
+ new $P5, .ManagedStruct, $P2
+ set $I6, 0
+ sizeof $I7, .DATATYPE_INT16
+ add $I6, $I7
+ add $I6, $I7
+ sizeof $I7, .DATATYPE_UINT16
+ add $I6, $I7
+ add $I6, $I7
+
+ set $P5, I6
+
+ .pcc_begin_return
+ .return $P5
+ .pcc_end_return
+.end
+
+.pcc_sub _new_SDL_Color prototyped
+ .param int red
+ .param int green
+ .param int blue
+
+ new $P2, .OrderedHash
+ set $P2['r'], .DATATYPE_UINT8
+ push $P2, 0
+ push $P2, 0
+ set $P2['g'], .DATATYPE_UINT8
+ push $P2, 0
+ push $P2, 0
+ set $P2['b'], .DATATYPE_UINT8
+ push $P2, 0
+ push $P2, 0
+ set $P2['a'], .DATATYPE_UINT8
+ push $P2, 0
+ push $P2, 0
+
+ new $P5, .ManagedStruct, $P2
+ set $I6, 0
+ sizeof $I7, .DATATYPE_UINT8
+ add $I6, $I7
+ add $I6, $I7
+ add $I6, $I7
+ add $I6, $I7
+
+ set $P5, $I6
+
+ print red
+ print "\n"
+ print green
+ print "\n"
+ print blue
+ print "\n"
+
+ set $P5['r'], red
+ set $P5['g'], green
+ set $P5['b'], blue
+
+ set $I0, $P5['r']
+ print $I0
+ print "\n"
+ set $I0, $P5['g']
+ print $I0
+ print "\n"
+ set $I0, $P5['b']
+ print $I0
+ print "\n"
+
+ .pcc_begin_return
+ .return $P5
+ .pcc_end_return
+.end
.sub _main
_init()
_MAIN()
end
.end
.include "library/sdl_types.imc"
.include "datatypes.pasm"
.pcc_sub _init prototyped
.include "library/sdl.pasm"
_init_SDL_types()
.end
.sub _MAIN
.local pmc SDL_Init
.local pmc SetVideoMode
.local pmc SDL_Quit
.local pmc SDL_UpdateRect
.local pmc SDL_FillRect
.local pmc new_SDL_Rect
.local object screen
SDL_Init = global "SDL::SDL_Init"
SetVideoMode = global "SDL::SDL_SetVideoMode"
SDL_Quit = global "SDL::SDL_Quit"
SDL_UpdateRect = global "SDL::SDL_UpdateRect"
SDL_FillRect = global "SDL::SDL_FillRect"
new_SDL_Rect = global "new_SDL_Rect"
.pcc_begin prototyped
.arg 255
.arg 65535
.nci_call SDL_Init
.pcc_end
.pcc_begin prototyped
.arg 640
.arg 480
.arg 16
.arg 0
.nci_call SetVideoMode
.result screen
.pcc_end
.local object blue_rect
.local object blue_color
.local Sub new_rect
.local Sub new_color
.local Sub update_rect
blue_rect = _new_SDL_Rect()
blue_color = _new_SDL_Color( 255, 0, 255 )
set blue_rect['w'], 100
set blue_rect['h'], 100
set blue_rect['x'], 270
set blue_rect['y'], 190
.pcc_begin prototyped
.arg screen
.arg blue_rect
.arg blue_color
.nci_call SDL_FillRect
.pcc_end
.pcc_begin prototyped
.arg screen
.arg 0
.arg 0
.arg 0
.arg 0
.nci_call SDL_UpdateRect
.pcc_end
set $I0, 2
sleep $I0
.pcc_begin prototyped
.nci_call SDL_Quit
.pcc_end
.pcc_begin_return
.pcc_end_return
.end
